问题
I am new to VBA and was looking for help in writing a sub or code that can compare the same column (B) of two tables on 2 different sheets and combine them into a single table on the first sheet. I have looked at ways to do it and am really confused about using ranges or unions as a solution. I want it to find items both missing from column b in sheet 2 (which will have a dynamic, but known name stored in a variable) and add that entire row to sheet 1 (named 'Dump' with an additional comment on column d, as well as check for rows present in 'Dump' but not present in the other sheet. It only needs to compare column b of the two sheets as column b is the key.
Here's an example of what I am looking for given 2 sheets of data, and the final output.
**Sheet 'Dump'**
+---------------------------+-----+------------------+---+
| A | B | C | D |
+---------------------------+-----+------------------+---+
| v62: Cheetah Mail | v62 | 206 | |
| c49: Report Suite | c49 | appid | |
| v75: Message Type | v75 | NDS Error | |
| v42: Core | v42 | fd8000d7 | |
| c37: Message Key | c37 | fd8000d7 | |
+---------------------------+-----+------------------+---+
**Sheet 'ICD'**
+---------------------------+-----+-----------+---+
| A | B | C | D |
+---------------------------+-----+-----------+---+
| v62: Cheetah Mail | v62 | 206 | |
| c44: Portal | c44 | polo | |
| v75: Message Type | v75 | NDS Error | |
| v42: Core | v42 | fd8000d7 | |
| c37: Message Key | c37 | fd8000d7 | |
+---------------------------+-----+-----------+---+
Output Sheet 'Dump'
+--------------------+-----+-----------+---------------------------------------+
| A | B | C | D |
+--------------------+-----+-----------+---------------------------------------+
| v62: Cheetah Mail | v62 | 206 | |
| c44: Portal | c44 | polo | Item found in "ICD" but not in "Dump" |
| c49: Report Suite | c49 | appid | Item found in "Dump" but not in "ICD" |
| v75: Message Type | v75 | NDS Error | |
| v42: Core | v42 | fd8000d7 | |
| c37: Message Key | c37 | fd8000d7 | |
+--------------------+-----+-----------+---------------------------------------+
It doesn't matter where the row is placed as it will be sorted later. Thank you so much for the help
回答1:
Here, I got one for you. My code can give right answer for matching two sheet. But the order is not equal with yours. I think that it is no matter what is the order of result row. OK, let check my code:
Public Sub matchRow()
Dim dumpSheet, icdSheet, outputSheet As Worksheet
Dim startRow, outputRow, tempDumpRow, tempICDRow, icdRowCount, finishedICDIndex As Integer
Dim finishedICD() As String
Dim isExist As Boolean
'Set sheets
Set dumpSheet = Sheets("Dump")
Set icdSheet = Sheets("ICD")
Set outputSheet = Sheets("Output")
'Set start row of each sheet for data
startRow = 1
outputRow = 1
'Get row count from ICD sheet
icdRowCount = icdSheet.Range("A:C").End(xlDown).row
'Set index
finishedICDIndex = 0
'Re-define array
ReDim finishedICD(0 To icdRowCount - 1)
'Set the start row
tempDumpRow = startRow
'Here I looped with OR state, you can modify it to AND start if you want
Do While dumpSheet.Range("A" & tempDumpRow) <> "" Or dumpSheet.Range("B" & tempDumpRow) <> "" Or dumpSheet.Range("C" & tempDumpRow) <> ""
'Reset exist flag
isExist = False
'loop all row in ICD sheet
For tempICDRow = 1 To icdRowCount Step 1
'If row is not finished for checking.
If UBound(Filter(finishedICD, tempICDRow)) < 0 Then
'If all cell are equal
If dumpSheet.Range("A" & tempDumpRow) = icdSheet.Range("A" & tempICDRow) And _
dumpSheet.Range("B" & tempDumpRow) = icdSheet.Range("B" & tempICDRow) And _
dumpSheet.Range("C" & tempDumpRow) = icdSheet.Range("C" & tempICDRow) Then
'Set true to exist flag
isExist = True
'Store finished row
finishedICD(finishedICDIndex) = tempICDRow
finishedICDIndex = finishedICDIndex + 1
'exit looping
Exit For
End If
End If
Next tempICDRow
'Show result
outputSheet.Range("A" & outputRow) = dumpSheet.Range("A" & tempDumpRow)
outputSheet.Range("B" & outputRow) = dumpSheet.Range("B" & tempDumpRow)
outputSheet.Range("C" & outputRow) = dumpSheet.Range("C" & tempDumpRow)
If isExist Then
outputSheet.Range("D" & outputRow) = ""
Else
outputSheet.Range("D" & outputRow) = "Item found in ""Dump"" but not in ""ICD"""
End If
'increase output row
outputRow = outputRow + 1
'go next row
tempDumpRow = tempDumpRow + 1
Loop
'loop all row in ICD sheet
For tempICDRow = 1 To icdRowCount Step 1
'If row is not finished for checking.
If UBound(Filter(finishedICD, tempICDRow)) < 0 Then
'Show result
outputSheet.Range("A" & outputRow) = icdSheet.Range("A" & tempICDRow)
outputSheet.Range("B" & outputRow) = icdSheet.Range("B" & tempICDRow)
outputSheet.Range("C" & outputRow) = icdSheet.Range("C" & tempICDRow)
outputSheet.Range("D" & outputRow) = "Item found in ""ICD"" but not in ""Dump"""
'increase output row
outputRow = outputRow + 1
End If
Next tempICDRow
End Sub
I guarantee for my answer that it will give the right answer for any data set. Here, my test evidence for my code.
Dump Sheet data:
ICD Sheet data:
This is result:
I know that this answer is not same in order with yours. But I believe that will be helpful for you.
回答2:
The fastest way to compare data existing in two sheets (in case when key exists) is to use ADODB objects. Please, have a look ar example and read comments in code.
Sub CompareDataViaSql()
'declare variables
Dim i As Long, vSheets As Variant, sSql As String
Dim srcWsh As Worksheet, dstWsh As Worksheet
Dim oConn As ADODB.Connection, oRst As ADODB.Recordset
'on error go to error handler
On Error GoTo Err_CompareDataViaSql
'add destination sheet
Set dstWsh = ThisWorkbook.Worksheets.Add(After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count))
dstWsh.Name = "ResultList_" & Format(Now, "yyyyMMddHHss")
'define collection of sheets to loop through
vSheets = Array("Dump", "ICD")
'loop through the collection of sheets
'build sql command
For i = LBound(vSheets) To UBound(vSheets)
Set srcWsh = ThisWorkbook.Worksheets(vSheets(i))
sSql = sSql & "SELECT [F1], [F2], [F3], '" & srcWsh.Name & "' AS [F4]" & vbCr & _
"FROM [" & srcWsh.Name & "$" & Replace(srcWsh.UsedRange.Address, "$", "") & "]" & vbCr & _
"UNION ALL" & vbCr
Next i
'remove last UNION ALL command
sSql = Left(sSql, Len(sSql) - 10)
'continue building sql command
'in this case - pivot table
sSql = "TRANSFORM COUNT(T.[F2])" & vbCr & _
"SELECT T.[F1], T.[F2], T.[F3]" & vbCr & _
"FROM (" & sSql & ") AS T" & vbCr & _
"GROUP BY T.[F1], T.[F2], T.[F3]" & vbCr & _
"PIVOT(T.[F4])"
'create new adodb connection
Set oConn = New ADODB.Connection
With oConn
'define connection string
.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & ";" & _
"Extended Properties='Excel 12.0 Macro;HDR=NO';"
'open connection
.Open
End With
'create new adodb recordset
Set oRst = New ADODB.Recordset
'open recordset
oRst.Open sSql, oConn, adOpenStatic, adLockReadOnly
'add headers
For i = 0 To oRst.Fields.Count - 1
dstWsh.Range("A1").Offset(ColumnOffset:=i) = oRst.Fields(i).Name
Next
i = i - 1
With dstWsh.Range("A1:" & dstWsh.Range("A1").Offset(ColumnOffset:=i).Address)
.Font.Bold = True
.Font.Color = vbRed
.Interior.Color = vbYellow
End With
'define destination row
i = 2
'copy data from recordset
dstWsh.Range("A" & i).CopyFromRecordset oRst
'fit columns width
dstWsh.UsedRange.Columns.AutoFit
'clean up
Exit_CompareDataViaSql:
On Error Resume Next
oRst.Close
Set oRst = Nothing
oConn.Close
Set oConn = Nothing
Set srcWsh = Nothing
Set dstWsh = Nothing
Exit Sub
'error handler
Err_CompareDataViaSql:
MsgBox Err.Description, vbExclamation, Err.Number
Resume Exit_CompareDataViaSql
End Sub
Result:
F1 F2 F3 Dump ICD
c37: Message Key c37 fd8000d7 1 1
c44: Portal c44 polo 1
c49: Report Suite c49 appid 1
v42: Core v42 fd8000d7 1 1
v62: Cheetah Mail v62 206 1 1
v75: Message Type v75 NDS Error 1 1
Note: This isn't exactly what you want, but... Assuming that 1 means data exists on list and null means data does not exists: c44 exists only on ICD list and c49 exists only on Dump list.
For further information, please see: TRANSFORM (MS Access)
来源：https://stackoverflow.com/questions/31667675/vba-compare-tables-on-2-sheets-with-differences