0

## VBA 不同資料表比對

ski 2020-06-18 17:22:581685 瀏覽

### 1 個回答

1

iT邦大神 1 級 ‧ 2020-06-18 17:49:59

``````Sub Main()
For nI = 1 To 12 '判斷12個月份
nR1 = FindMonth("Sheet1", nI & "月")
nR2 = FindMonth("Sheet2", nI & "月")
If (nR1 = 0 And nR2 = 0) Then '兩個工作表都沒有，不用處理
Else
If (nR1 * nR2 = 0) Then '只有一個工作表有，複製到 sheet3
Call CopyRow("Sheet1", nR1)
Call CopyRow("Sheet2", nR2)
End If
End If
Next nI
End Sub
'在 sheet 找特定月份，找到回傳列號，找不到回傳 0
Function FindMonth(ByVal sheet, ByVal month) As Integer
nRet = 0
For nI = 2 To 10
If Range(sheet & "!D" & nI).Value = month Then
nRet = nI
Exit For
End If
Next nI
FindMonth = nRet
End Function
'將 sheet 第 sourcerow 列複製到 sheet3 的第一筆空白列
Sub CopyRow(ByVal sheet, ByVal sourcerow)
If sourcerow = 0 Then Exit Sub
Worksheets("Sheet3").Select
Range("A100").End(xlUp).Offset(1, 0).Select
targetrow = ActiveCell.Row
Dim arrC
arrC = Array("A", "B", "C", "D")
For nC = 0 To UBound(arrC)
Range("Sheet3!" & arrC(nC) & targetrow) = Range(sheet & "!" & arrC(nC) & sourcerow)
Next nC
End Sub
``````

ski iT邦新手 5 級 ‧ 2020-06-19 08:22:53 檢舉

ski iT邦新手 5 級 ‧ 2020-06-19 08:23:10 檢舉

ski iT邦新手 5 級 ‧ 2020-06-19 09:24:11 檢舉

Sheet1和Sheet2各有11個欄位(A欄 ~ K欄)

(Sheet1和Sheet2的D欄互相比對)

Sheet1

Sheet2

Sheet3 比對出來結果

Sheet3會有幾筆12月？

ski iT邦新手 5 級 ‧ 2020-06-19 11:00:44 檢舉

ski iT邦新手 5 級 ‧ 2020-06-19 12:57:38 檢舉

ski iT邦新手 5 級 ‧ 2020-06-19 16:36:14 檢舉

Range("Sheet3!" & arrC(nC) & targetrow) = Range(sheet & "!" & arrC(nC) & sourcerow)

``````Range("Sheet3!A4") = Range("Sheet2!A3")
Range("Sheet3!B4") = Range("Sheet2!B3")
Range("Sheet3!C4") = Range("Sheet2!C3")
Range("Sheet3!D4") = Range("Sheet2!D3")
``````

targetrow 就是 4
sheet 就是 "Sheet2"
sourcerow 就是 3

ski iT邦新手 5 級 ‧ 2020-06-20 08:55:33 檢舉

ski iT邦新手 5 級 ‧ 2020-06-20 15:01:11 檢舉

``````Sub Main()

nRow = 1
For nI = 2 To 300
A = Range("Sheet1!D" & nI)
B = Range("Sheet2!D" & nI)
If (A = 0 And B = 0) Then
Else
If A <> B Then
nRow = nRow + 1
Call CopyRow("Sheet1", A)
Call CopyRow("Sheet2", B)
End If
End If
Next nI
End Sub

Sub CopyRow(ByVal sheet, ByVal sourcerow)
If sourcerow = 0 Then Exit Sub
Worksheets("Sheet3").Select
Range("A300").End(xlUp).Offset(1, 0).Select
targetrow = ActiveCell.Row
Dim arrC
arrC = Array("A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K")
For nC = 0 To UBound(arrC)
Range("Sheet3!" & arrC(nC) & targetrow) = Range(sheet & "!" & arrC(nC) & sourcerow)
Next nC
End Sub
``````

``````用`1月..12月`分別到Sheet1,Sheet2去找，只有其中一個工作表有找到時，複製該整列到Sheet3
``````

``````Sheet1!D2跟Sheet2!D2比
Sheet1!D3跟Sheet2!D3比
...
Sheet1!D300跟Sheet2!D300比

``````

ski iT邦新手 5 級 ‧ 2020-06-20 15:33:30 檢舉