如何用VBA实现时间和金额的对账

zouwen

如何用VBA实现时间和金额的对账，根据日期金额银行POS在手工数据未匹配上的标记X，手工数据同日期同金额多登记和同日期金额不一致的标记X,如达到效果

凌空一羽

Sub lkyy()
Dim f As Boolean
Sheet1.Activate
ar = Sheet2.Range("a1").CurrentRegion
For i = 2 To 19
    t = Cells(i, 1) & "|" & Cells(i, "I")
    f = False
    For j = 2 To UBound(ar)
        tt = ar(j, 1) & "|" & ar(j, 2)
        If t = tt Then f = True: Exit For
    Next
    If f = True Then Cells(i, "J") = "√" Else Cells(i, "J") = "×"
Next
Columns(10).Font.Color = vbRed

Sheet2.Activate
ar = Sheet1.Range("a1").CurrentRegion
For i = 2 To 19
    t = Cells(i, 1) & "|" & Cells(i, 2)
    f = False
    For j = 2 To UBound(ar)
        tt = ar(j, 1) & "|" & ar(j, 9)
        If t = tt Then f = True: Exit For
    Next
    If f = True Then Cells(i, 3) = "√" Else Cells(i, 3) = "×"
Next
Columns(3).Font.Color = vbRed
End Sub

一把小刀闯天下

Option Explicit

Sub test()
  Dim sht, i, j, t, p
  sht = Split("银行POS 手工数据")
  ReDim dic(UBound(sht)), arr(UBound(sht))
  For i = 0 To UBound(dic)
    Set dic(i) = CreateObject("scripting.dictionary")
    arr(i) = Sheets(sht(i)).[a1].CurrentRegion
    If i = 0 Then p = 7 Else p = 2
    For j = 2 To UBound(arr(i), 1)
      dic(i)(arr(i)(j, 1) & "|" & arr(i)(j, p)) = 1
    Next
  Next
  For i = 0 To UBound(dic)
    If i = 0 Then p = 7 Else p = 2
    For j = 2 To UBound(arr(i), 1)
      t = arr(i)(j, 1) & "|" & arr(i)(j, p)
      If dic(1 - i).exists(t) Then
        If i = 0 Then
          arr(i)(j, UBound(arr(i), 2)) = "√"
        Else
          If dic(1 - i)(t) = 1 Then
            dic(1 - i)(t) = 0
            arr(i)(j, UBound(arr(i), 2)) = "√"
          Else
            arr(i)(j, UBound(arr(i), 2)) = "×"
          End If
        End If
      Else
        arr(i)(j, UBound(arr(i), 2)) = "×"
      End If
    Next
    Sheets(sht(i)).[a1].Offset(, UBound(arr(i), 2) + 1).Resize(UBound(arr(i), 1), UBound(arr(i), 2)) = arr(i) '对比用，修改输出位置
  Next
End Sub