比较两张表中的数据并将其写入同一工作簿的另一张表中

Question

我希望我的代码执行的操作：有一个名为“DB”的工作表，其中包含从表中获取的数据。我有“XML”工作表，其中包含从 XML 获取的数据。我想从“DB”表中获取列名“FName”并在“XML”表中搜索相同的列名“FName”。如果列名匹配，则从“DB”表中获取相应的值并与“XML”表进行比较。我在同一个工作簿中有另一张“结果”表。我从“DB”表中获取了列名并粘贴了转置（按行排列）。我必须做以下场景：
1. 如果两个工作表中的列名匹配：
- 在两个工作表中搜索对应列名的值匹配。如果值匹配，在“结果”表中，我必须在列名为“FName”的行旁边的列中写下“匹配”或“不匹配”。

2.如果两个工作表中的列名都不匹配：
- 在“结果”表中，我必须在列名为“FName”的行旁边的列中写下“NO Matching COLUMN”。

目前，在这段代码中，我想解析“DB”表中的每一列并搜索该列。但我收到“应用程序定义或对象定义错误”。

请告诉我如何实现上述场景：

Dim FindString As Range
Dim Rng As Range

Dim i, j As Integer
Dim finalcol As Long

Worksheets("DB").Select

finalcol = Worksheets("DB").Cells(1, Application.Columns.Count).End(x1toleft).column
On Error Resume Next


For i = 1 To finalcol
 FindString = Cells(1, i).Value

If Trim(FindString) <> "" Then
    With Sheets("xml").Range("A:A")
        Set Rng = .Find(What:=FindString, _
                        After:=.Cells(.Cells.Count), _
                        LookIn:=xlValues, _
                        LookAt:=xlWhole, _
                        SearchOrder:=xlByRows, _
                        SearchDirection:=xlNext, _
                        MatchCase:=False)
        If Not Rng Is Nothing Then
            Application.Goto Rng, True
        Else
            MsgBox "Nothing found"
        End If
    End With
End If
Next i
 On Error GoTo 0

结束子

Answer 1

根据您的描述，这是我能想到的。行数取决于“DB”表中有多少行

 Private Function CheckColumn(SheetN As String, col As String)   
 'checks if a column is in sheet returns errorif not found 
 On Error GoTo NotHere
     CheckColumn = WorksheetFunction.Match(col, Sheets(SheetN).Rows(1), 0)
 On Error GoTo 0

Exit Function
    NotHere:
        MsgBox col & " was not found in sheet " & SheetN    
End Function

Sub MatchNoMatch()
Dim rngDB As Range
Dim colname As String
Dim sh1 As String
Dim sh2 As String
Dim sh3 As String
Dim dbcol As Integer
Dim xmlcol As Integer
Dim rcol As Integer
Dim Firstrow As Long
Dim Lastrow As Long

'column you want to search up
colname = "FNAME"

'the sheets you want to find the column in
sh1 = "DB"
sh2 = "XML"
sh3 = "RESULT"

'Gets the column number from each sheet
dbcol = CheckColumn(sh1, colname)
xmlcol = CheckColumn(sh2, colname)
rcol = CheckColumn(sh3, colname)

'Sets the range for sh1 to do compare
With Worksheets(sh1)
    Firstrow = .UsedRange.Cells(1).Row + 1
    Lastrow = .UsedRange.Rows(.UsedRange.Rows.Count).Row
    Set rngDB = .Range(.Cells(Firstrow, dbcol), .Cells(Lastrow, dbcol))
End With

'checks each value against sh2 and writes in sh3. If more values in sh2 they will be ignored
For Each e In rngDB
    If e.Value <> Worksheets(sh2).Cells(e.Row, xmlcol) Then
        Worksheets(sh3).Cells(e.Row, rcol + 1) = "NO MATCH"
    Else
        Worksheets(sh3).Cells(e.Row, rcol + 1) = "MATCH"
    End If
Next e
End Sub