|
参与一下。。。- Sub ykcbf() '//2023.12.29
- Dim arr
- Set d = CreateObject("Scripting.Dictionary")
- rq = Format(Date, "yyyy年mm月")
- With Sheets("Sheet2")
- r = .Cells(Rows.Count, 3).End(3).Row
- arr = .Range("c2:h" & r)
- End With
- For i = 2 To UBound(arr)
- yf = Format(arr(i, 3), "yyyy年mm月")
- s = yf & arr(i, 1)
- If yf = rq Then
- If Not d.exists(s) Then
- d(s) = Array(arr(i, 4), arr(i, 5), arr(i, 6))
- End If
- End If
- Next
- With Sheets("Sheet1")
- r = .Cells(Rows.Count, 2).End(3).Row
- .Range("d3:f" & r) = ""
- arr = .Range("b2:f" & r)
- For i = 2 To UBound(arr)
- s = rq & arr(i, 1)
- If d.exists(s) Then
- For j = 3 To UBound(arr, 2)
- arr(i, j) = d(s)(j - 3)
- Next
- End If
- Next
- .Range("b2:f" & r) = arr
- End With
- Set d = Nothing
- MsgBox "OK!"
- End Sub
复制代码
|
评分
-
2
查看全部评分
-
|