[已解决]填充中间缺少的日期（for 循环）（已解决）

逍遥007

gTnquUga.rar (8.1 KB, 下载次数: 12)

2010-7-22 06:19 上传

点击文件名下载附件
填充中间缺少的日期（for 循环）
请教各位，在附件中，如果B列相等，填充A列中缺少的日期。
我写的代码中，一次只能填两行，要得到我想要的结果，得运行3次。
请教大家，应该怎么改？

[此贴子已经被作者于2010-7-23 23:29:47编辑过]

最佳答案

月排行榜 / 总排行榜

开辆小富康

2010-7-22 07:32

Sub tt()
    Dim Rcount%
  With Sheet1
    For n = Sheet1.[a65536].End(xlUp).Row To 2 Step -1
        If .Cells(n, 2) = .Cells(n - 1, 2) Then
            Rcount = .Cells(n, 1) - .Cells(n - 1, 1)
            If Rcount > 1 Then
                Rows(n & ":" & n + Rcount - 2).Insert shift:=xlDown
                For i = n To n - 2 + Rcount
                .Cells(i, 1) = .Cells(i - 1, 1) + 1
                .Cells(i, 2) = .Cells(i - 1, 2)
                Next
            End If
        End If
    Next
  End With
End Sub

跳转到最佳答案楼层

ddcl

[em10]

开辆小富康

Sub tt()
    Dim Rcount%
  With Sheet1
    For n = Sheet1.[a65536].End(xlUp).Row To 2 Step -1
        If .Cells(n, 2) = .Cells(n - 1, 2) Then
            Rcount = .Cells(n, 1) - .Cells(n - 1, 1)
            If Rcount > 1 Then
                Rows(n & ":" & n + Rcount - 2).Insert shift:=xlDown
                For i = n To n - 2 + Rcount
                .Cells(i, 1) = .Cells(i - 1, 1) + 1
                .Cells(i, 2) = .Cells(i - 1, 2)
                Next
            End If
        End If
    Next
  End With
End Sub

逍遥007

十分感谢，又学了一招，问题解决了。