Option Explicit
Sub TEST()
Dim Brr, Y, i&, j%, T$, xR As Range, Sh
Set Y = CreateObject("Scripting.Dictionary")
Sh = Array(, Sheets("sheet2"), Sheets("sheet1"))
For j = 1 To 2
Set xR = Range(Sh(j).[A1], Sh(j).Cells(Rows.Count, "F").End(3))
Brr = xR
For i = 2 To UBound(Brr)
T = Format(Brr(i, 2), "YYYY-MM-")
Y(T) = Y(T) + 1
Brr(i, 1) = T & Format(Y(T), "000")
Next
If j = 2 Then
Intersect(xR.Offset(1, 0), [A:A]).ClearContents
xR = Brr
End If
Next
Set Y = Nothing: Set xR = Nothing: Set Sh = Nothing: Erase Brr
End Sub
發表於 2023-4-7 14:31
| 
