比較兩張表中的數據並將其寫入同一工作簿中的另一張表中

Question

我想要我的代碼執行的操作：存在一張名爲「DB」的表，其中有來自表的數據。我有從XML獲取數據的「XML」工作表。我想從「DB」工作表中取一個列名「FName」，並在「XML」工作表中搜索同一列名「FName」。如果列名匹配，則從「DB」表中取對應值並與「XML」表進行比較。我在同一個工作簿中有另一張「結果」。我從「數據庫」表中獲取了列名並粘貼了轉置（列中的列）。我必須做下面的情景：
1.如果兩個表中的列名匹配：
- 在兩張表中搜索相應列名的值匹配。如果值匹配，在「結果」表中，我必須在列名爲「FName」的行旁邊的列中寫入「匹配」或「不匹配」。

2.if列名在兩個表中都不匹配：
- 在「結果」表中，我必須在列名稱爲「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