修改表

870734707

需要的效果，根据“修改记录”表中，如果修改日期是当天则对“计划”表中对应的数据进行替换。

gwjkkkkk

Option Explicit
Sub TEST6()
    Dim ar, i&, dic As Object
   
    Application.ScreenUpdating = False
    Set dic = CreateObject("Scripting.Dictionary")
   
    With Worksheets(2).[A1].CurrentRegion
        ar = .Value
        For i = 3 To UBound(ar)
            If CDate(Format(Now(), "yyyy/m/d")) = ar(i, 5) Then
                 dic(ar(i, 2)) = .Cells(i, 3).Resize(, 2).Value
            End If
        Next i
    End With
   
    With Worksheets(1).[B2].CurrentRegion
        ar = .Value
        For i = 3 To UBound(ar)
            If dic.exists(ar(i, 1)) Then .Cells(i, 2).Resize(, 2).Value = dic(ar(i, 1))
        Next i
        .Activate
    End With
   
    Set dic = Nothing
    Application.ScreenUpdating = True
    Beep
End Sub

gwjkkkkk

。。。。。。。。。。。

quqiyuan

参与一下，仅供参考。。。

quqiyuan

代码如下。。。。
Sub test()
    Dim sht As Worksheet, sh As Worksheet, arr
    Set sht = ThisWorkbook.Sheets("修改记录")
    Set sh = ThisWorkbook.Sheets("计划")
    arr = sht.UsedRange
    brr = sh.[b2].CurrentRegion
    Set d = CreateObject("scripting.dictionary")
    For i = 3 To UBound(arr)
        If arr(i, 5) = Date Then
            s = arr(i, 2) & "|" & arr(i, 5)
            d(s) = Array(arr(i, 3), arr(i, 4))
        End If
    Next
    Key = d.keys
    Item = d.items
    For i = 3 To UBound(brr)
        For j = 0 To UBound(Key)
            If InStr(Key(j), brr(i, 1)) Then
                brr(i, 2) = d(Key(j))(0)
                brr(i, 3) = d(Key(j))(1)
                Exit For
            End If
        Next
        If j = UBound(Key) + 1 Then
            brr(i, 3) = brr(i, 2)
        End If
    Next
    Set d = Nothing
    sh.[b24].Resize(UBound(brr), UBound(brr, 2)) = brr
    Beep
End Sub