Option Explicit
Sub TEST()
Dim Z, xR As Range
Set Z = CreateObject("Scripting.Dictionary")
For Each xR In Sheets("編號").Cells.SpecialCells(2)
If xR Like "[A-Z]#####" Then Z(xR.Value) = xR(1, 0)
Next
Sheets("人名對照").UsedRange.Offset(1).EntireRow.Delete
Sheets("人員編號").UsedRange.Offset(1).Copy [人名對照!A2]
For Each xR In Sheets("人名對照").Cells.SpecialCells(2)
If Z.Exists(xR.Value) Then xR = Z(xR.Value)
Next
End Sub作者: GGGYYY 時間: 2024-3-22 13:49
Option Explicit
Sub TEST()
Dim Z, xR As Range
'↑宣告變數:xR變數是儲存格變數,Z是通用變數
Set Z = CreateObject("Scripting.Dictionary")
'↑令Z變數是 字典
For Each xR In Sheets("編號").Cells.SpecialCells(2)
'↑設逐項迴圈!令xR變數是 工作表裡的非空格儲存格
If xR Like "[A-Z]#####" Then Z(xR.Value) = xR(1, 0)
'↑如果xR變數值類型是 大寫英文字開頭再連接5碼數字所組成的字串?
'True就令已xR變數值為key,item是xR變數左側儲存格值,納入Z字典
Next
Sheets("人名對照").UsedRange.Offset(1).EntireRow.Delete
'↑令舊資料刪除
Sheets("人員編號").UsedRange.Offset(1).Copy [人名對照!A2]
'↑令資料複製到結果表
For Each xR In Sheets("人名對照").Cells.SpecialCells(2)
'↑設逐項迴圈!令xR變數是 工作表裡的非空格儲存格
If Z.Exists(xR.Value) Then xR = Z(xR.Value)
'↑如果Z字典裡有 xR變數值?就令xR變數值是 以xR變數值查Z字典回傳item值
Next
End Sub作者: Andy2483 時間: 2024-3-28 12:57
Option Explicit
Sub TEST_20240328_1()
Dim xR As Range, Brr, i%, j%, T$, Crr, R%
ReDim Crr(1 To 1000, 1 To 6)
With Sheets("編號")
Brr = .UsedRange
For j = 1 To UBound(Brr, 2) Step 3
For i = 1 To UBound(Brr)
Set xR = .Cells(i, j): If xR.MergeArea.Cells.Count = 2 And xR <> "" And xR <> T Then T = xR: GoTo i01
R = R + 1: Crr(R, 1) = R: Crr(R, 2) = T: Crr(R, 3) = Brr(i, j): Crr(R, 4) = Brr(i, j + 1)
i01: Next
Next
End With
Workbooks.Add: [A1].Resize(, 6) = [{"NO.","職稱","姓名","人員編號","團購明細","總金額"}]
With [A2].Resize(R, 6)
.Value = Crr
.Columns(5).ColumnWidth = 25
.Borders.LineStyle = 1
Range([A1], .Cells).Name = "'" & ActiveSheet.Name & "'!Print_Area"
End With
End Sub作者: hcm19522 時間: 2024-3-28 14:44
