楼主 wcymiss |
Q:如附件,A:D列与F:I列进行对账,依据是B列和G列。希望用vba实现:B列和G列相同的,在一行里显示;B列有而G列无的,F:I列显示空白;G列有而B列无的,在F:I最下方显示。 A:代码如下:
- Sub 对账()
- Dim d, arr, brr, crr(), i&, r1, r2, j&, drr
- Set d = CreateObject("scripting.dictionary")
- r1 = Cells(Rows.Count, "B").End(3).Row
- r2 = Cells(Rows.Count, "G").End(3).Row
- arr = Range("a3:d" & r1)
- brr = Range("f3:i" & r2)
- For i = 1 To r2 - 2
- d(brr(i, 2)) = i
- Next
- ReDim Preserve crr(1 To 4, 1 To r1 - 2)
- For i = 1 To r1 - 2
- If d.exists(arr(i, 2)) Then
- crr(1, i) = brr(d(arr(i, 2)), 1)
- crr(2, i) = brr(d(arr(i, 2)), 2)
- crr(3, i) = brr(d(arr(i, 2)), 3)
- crr(4, i) = brr(d(arr(i, 2)), 4)
- d(arr(i, 2)) = 0
- If i = 140 Then
- i = i
- End If
-
- End If
- Next
- drr = d.items
- j = r1 - 2
- For i = 0 To UBound(drr)
- If drr(i) > 0 Then
- j = j + 1
- ReDim Preserve crr(1 To 4, 1 To j)
- crr(1, j) = brr(drr(i), 1)
- crr(2, j) = brr(drr(i), 2)
- crr(3, j) = brr(drr(i), 3)
- crr(4, j) = brr(drr(i), 4)
- End If
- Next
- With Sheets("效果")
- .Cells.ClearContents
- .Columns("B:B").NumberFormatLocal = "@"
- .Columns("G:G").NumberFormatLocal = "@"
- Range("2:2").Copy .Range("2:2")
- .[a3].Resize(UBound(arr), 4) = arr
- .[f3].Resize(UBound(crr, 2), 4) = Application.Transpose(crr)
- End With
- Set d = Nothing
- End Sub
4月对账用.rar |