EXCEL VBA．比對兩表，〔編號相同〕者填入對應內容並刪除之
＜．准提部林．＞
－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
■程式碼：
Sub 兩表匯整()
Dim xH As Range, xE As Range, j&, Jm&, Ym&
Dim xDic As Object, xR As Range
Set xE = [I65536].End(xlUp)
If xE.Row < 11 Or xE = "NO" Then Exit Sub
Set xDic = CreateObject("Scripting.Dictionary")
For j = xE.Row To 11 Step -1
Set xR = Range("I" & j)
If xR = "NO" Then Jm = j: Set xH = xR: _
Range(xH(2, 2), xE(1, 2)) = "*****": GoTo 101
If Jm = 0 And xR <> "" Then xDic(xR.Value) = xR(1, -2): GoTo 101
If Jm > 0 And xR <> "" Then
If xDic(xR.Value) <> "" Then
xR(1, -2) = xDic(xR.Value): Ym = 1
Range(xH(2, 1), xE).Replace xR, "#N/A", Lookat:=xlWhole
Else
With xR(1, -2): .Value = "未定": .Interior.ColorIndex = 1: _
.Font.ColorIndex = 2: End With
End If
End If
101: Next
If Jm = 0 Then MsgBox "※第２表標題無〔NO〕文字或資料！": Exit Sub
If Ym = 1 Then Range(xH(2, 1), xE).SpecialCells(xlCellTypeConstants, 16).EntireRow.Delete
Set xE = xH.End(xlUp)
If xH(0, 1) <> "" Then Set xE = xH(0, 1)
Range(xE(2), xH).EntireRow.Delete
End Sub
■說明：
另一程式碼寫法及相關註解請參閱範例檔。
－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
＜範例檔＞下載（附程式碼註解）：
－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
留言列表
