Excel VBA比較兩個工作表並將某些單元格輸出到新的工作表

Question

我已經嘗試了幾個小時才能做到這一點，但是我不是VBScript的專家，我想我需要一些幫助。

這就是我要面對的。 我有2個不同的工作表，其中包含一些相同的信息。

WORKSHEET1
Section/Dept    City    Building    SVD User Name   Item Short Code Item Full Name      SUPPLIER_SC Serial Number       IP Address  Product Class   Product     Item Status
BT&IT-         WINNIPEG GATEWAY CO  IT NETWORK      CHK0639V1JX     07JACM401093000MSYS000  CISCO   WNPIMBTVBBN-DSTH    1.2.3.4     SWITCHES       3550-24       ACTIVE

WORKSHEET2
Hostname           Management IP    Device Type        Vendor   Model           Software Version    Serial Number   Location    In Site
wnpimbtvbbn-dsth    1.2.3.4          Cisco IOS Switch   Cisco   catalyst355024  12.1(11)EA1        CHK0639V1JX     Gateway CO   Entire Network\Winnipeg\MTS TV Head End\

我想做的是將兩者關聯起來並輸出到第三者，以便重組信息以導入數據庫。 基本上，如果在WORKSHEET1的“項目短代碼/項目全名/序列”中找到“主機名”形式WORKSHEET2，我想輸出“ sheet1.item短代碼”，然后輸出SHEET2中的整個行，但要輸出不同的內容訂購。 另外，如果找不到匹配項，則從SHEET2輸出整行...

據我所知：

Sub CompareandOutput()
    Dim inv1 As Range
    Dim Assyst1 As Range
    Dim Assyst2 As Range
    Dim Assyst3 As Range
    Dim Inventory1Items As Range
    Dim Assyst1Items As Range
    Dim Assyst2Items As Range
    Dim Assyst3Items As Range
    Sheet3.Cells.Clear


    Set Inventory1Items = Sheet2.Range("A2", Sheet2.Range("A65536").End(xlUp))
    Set Assyst1Items = Sheet1.Range("E4", Sheet1.Range("E65536").End(xlUp))
    Set Assyst2Items = Sheet1.Range("F4", Sheet1.Range("F65536").End(xlUp))
    Set Assyst3Items = Sheet1.Range("H4", Sheet1.Range("H65536").End(xlUp))

    Sheet3.Range("A1") = "Old Short Code"
    Sheet3.Range("B1") = "New Short Code"
    Sheet3.Range("C1") = "New Full Name"
    Sheet3.Range("D1") = "Serial Number"
    Sheet3.Range("E1") = "Version"
    Sheet3.Range("F1") = "IP Address"
    Sheet3.Range("G1") = "Supplier"
    Sheet3.Range("H1") = "Product Class"
    Sheet3.Range("I1") = "Product"
    For Each inv1 In Inventory1Items
        Sheet3.Range("B65536").End(xlUp).Offset(1, 0) = inv1.Value
        Set Assyst1 = Assyst1Items.Find(inv1, LookIn:=xlValues, lookat:=xlWhole)
        If Not Assyst1 Is Nothing Then
        Sheet3.Range("A65536").End(xlUp).Offset(0, 0) = Cells(Assyst1.Row, "E")
        Sheet3.Range("C65536").End(xlUp).Offset(0, 0) = inv1.Value
        'Sheet3.Range("D65536").End(xlUp).Offset(1, 0) = Sheet2(Cells(Assyst1.Row, "D")).Select
        End If
        'Set Assyst2 = Assyst2Items.Find(inv1, LookIn:=xlValues, lookat:=xlWhole)
        'If Not Assyst2 Is Nothing Then
        'Sheet3.Range("B65536").End(xlUp).Offset(1, 0) = inv1.Row
        'End If
        'Set Assyst3 = Assyst3Items.Find(inv1, LookIn:=xlValues, lookat:=xlWhole)
        'If Not Assyst3 Is Nothing Then
        'Sheet3.Range("B65536").End(xlUp).Offset(1, 0) = inv1.Row
        'End If
    Next inv1


End Sub

我確定我在這里WAAAY偏離了軌道，並且有一種更簡單的方法來執行此操作。 任何幫助將不勝感激。

---

是的，仍然需要幫助。 取得了長足的進步，但還有最后一件微小的小事情不起作用。 基本上，我終生無法使用函數CheckForMatch來將其結果“ itemShortCode”傳遞給私有子項“ exporttonewworksheet”。 一切正常，直到函數結束，主子項和導出子項似乎未獲取值。 我確定我在這里不了解某些基本知識...

Public Enum Assyst1Columns
    Section_Dept = 1
    City
    Building
    SVD_User_Name
    Item_Short_Code
    Item_Full_Name
    SUPPLIER_SC
    Serial_Number
    IP_Address
    Product_Class
    Product
    Item_Status
End Enum

Public Enum Inventory1Columns
    Hostname = 1
    Management_IP
    Device_Type
    Vendor
    Model
    Software_Version
    Serial_Number
    Location
    In_Site
End Enum
Public Sub main()
    Dim Assyst As Excel.Worksheet
    Dim Inventory As Excel.Worksheet
    Dim Output As Excel.Worksheet
    Set Assyst = ThisWorkbook.Worksheets("Assyst")
    Set Inventory = ThisWorkbook.Worksheets("Inventory")
    Dim InventoryItems As Range
    Sheet3.Cells.Clear

    'Set Output1 = ThisWorkbook.Worksheets.Add

    'Output1.Name = "Output1"

    Dim newWkRow As Long
    newWkRow = 1


    Dim test As String
    Set InventoryItems = Inventory.Range("A2", Inventory.Range("A65536").End(xlUp))
    ' loop through wk2
    For Each hname In InventoryItems
        ' for each wk2.Cell found, call checkForMatch()
        ' store checkForMatch() value into variable
        itemShortCode = checkForMatch(hname, Assyst)
        'Sheet3.Range("A65536").End(xlUp).Offset(1, 0) = hname
        ' export to new worksheet
        test = itemShortCode

        exportToNewWorksheet Output, Inventory, hname.Row, newWkRow, itemShortCode

        newWkRow = newWkRow + 1 ' the only reason for newWkRow is if you want to skip any
                                ' entries from WORKSHEET2. So it's best to keep this count separate
                                ' from your current loop row

    Next
End Sub

Private Function checkForMatch(ByVal hname As String, ByRef Assyst As Excel.Worksheet) As String
    ' PLEASE NOTE: wk1 does NOT need to match in the function definition to that of the
    '               variable defined in main()
    ' search for match from Inventory to Assyst
    Dim item As String
    Dim test As String
    Dim matches As String
    Dim Assyst1Items As Range
    Set Assyst1Items = Assyst.Range("A4", Assyst.Range("L65536").End(xlUp))

    On Error Resume Next
    matches = Assyst1Items.Find(hname, LookIn:=xlValues, lookat:=xlWhole)

    ' if found, return the Item_Short_Code
    If Not matches = "" Then
        item = matches
    ' otherwise return vbNullString
    Else
        item = vbNullString
    End If
    itemShortCode = item
End Function

Private Sub exportToNewWorksheet(ByRef Output As Excel.Worksheet, _
                                ByRef Inventory As Excel.Worksheet, _
                                ByRef hname As Long, _
                                ByVal newWkRow As Long, _
                                Optional ByVal itemShortCode As String = vbNullString)

    ' put data into new row. be sure to use the Enum to re-order the column as you like
    If itemShortCode = "" Then
        Sheet3.Cells(newWkRow, 2).Value = Inventory.Cells(hname, Inventory1Columns.Hostname).Value
        Sheet3.Cells(newWkRow, 3).Value = Inventory.Cells(hname, Inventory1Columns.Hostname).Value
        Sheet3.Cells(newWkRow, 4).Value = Inventory.Cells(hname, Inventory1Columns.Management_IP).Value
        Sheet3.Cells(newWkRow, 5).Value = Inventory.Cells(hname, Inventory1Columns.Device_Type).Value
        Sheet3.Cells(newWkRow, 6).Value = Inventory.Cells(hname, Inventory1Columns.Vendor).Value
        Sheet3.Cells(newWkRow, 7).Value = Inventory.Cells(hname, Inventory1Columns.Model).Value
        Sheet3.Cells(newWkRow, 8).Value = Inventory.Cells(hname, Inventory1Columns.Software_Version).Value
        Sheet3.Cells(newWkRow, 9).Value = Inventory.Cells(hname, Inventory1Columns.Serial_Number).Value
    Else
        ' store data another way
        Sheet3.Cells(newWkRow, 1).Value = Assyst.Cells(hname, Assyst1Columns.Item_Short_Code).Value
        Sheet3.Cells(newWkRow, 2).Value = Inventory.Cells(hname, Inventory1Columns.Hostname).Value
        Sheet3.Cells(newWkRow, 3).Value = Inventory.Cells(hname, Inventory1Columns.Hostname).Value
        Sheet3.Cells(newWkRow, 4).Value = Inventory.Cells(hname, Inventory1Columns.Management_IP).Value
        Sheet3.Cells(newWkRow, 5).Value = Inventory.Cells(hname, Inventory1Columns.Device_Type).Value
        Sheet3.Cells(newWkRow, 6).Value = Inventory.Cells(hname, Inventory1Columns.Vendor).Value
        Sheet3.Cells(newWkRow, 7).Value = Inventory.Cells(hname, Inventory1Columns.Model).Value
        Sheet3.Cells(newWkRow, 8).Value = Inventory.Cells(hname, Inventory1Columns.Software_Version).Value
        Sheet3.Cells(newWkRow, 9).Value = Inventory.Cells(hname, Inventory1Columns.Serial_Number).Value
        ' etc...
    End If
End Sub

Answer 1

我懷疑是否有簡單的方法可以做到這一點。 據我了解，您想嘗試將一個工作表中的值匹配到另一個工作表中3個可能的列中，然后將兩個工作表中的某些數據輸出到新工作表中。 我真的沒有看到一種聰明，簡單的方法來做到這一點。

但是，這里有一些建議。 並且請原諒我陳述您已經知道的項目，因為它確實表明您知道如何編程：

利用Enum查找並重新排序復制的數據

例：

Public Enum wks1Columns
    Section_Dept = 1
    City
    Building
    SVD_User_Name
    Item_Short_Code
    etc
End Enum

Public Enum wks2Columns
    Hostname = 1
    Management_IP
    Device_Type
    etc
End Enum

Public Sub test()
    Dim wk1 As Excel.Worksheet
    Dim wk2 As Excel.Worksheet
    Set wk1 = ThisWorkbook.Worksheets("WORKSHEET1")
    Set wk2 = ThisWorkbook.Worksheets("WORKSHEET2")

    ' imagine Building is in column 5 in WORKSHEET1 and SVD is in column 7 in WORKSHEET1
    ' but you wanted to put them in columns 1 and 2 in the new worksheet
    Sheet1.Cells(1, 1).Value = wk1.Cells(1, wks1Columns.Building).Value
    Sheet1.Cells(1, 2).Value = wk1.Cells(1, wks1Columns.SVD_User_Name).Value

    ' and you wanted stuff from WORKSHEET2 in the same row
    Sheet1.Cells(1, 3).Value = wk2.Cells(1, wks2Columns.Hostname).Value
End Sub

使用枚舉，您可以存儲如何在工作表中設置列，然后在以后使用它們通過枚舉方法輕松地對新表進行重新排序。 很棒的事情是，如果第Dept的WORKSHEET1列移至第2列，City移至第1列，則只需要重新排序枚舉和BOOM，就可以完成代碼的修改;）

將功能分解為較小的任務

這絕對是您要完成的一項復雜任務，如果將所有這些都放在一個大的Sub ，將非常困難。 就像是：

Public Sub main()
    Dim wk1 As Excel.Worksheet
    Dim wk2 As Excel.Worksheet
    Dim wkNew As Excel.Worksheet
    Set wk1 = ThisWorkbook.Worksheets("WORKSHEET1")
    Set wk2 = ThisWorkbook.Worksheets("WORKSHEET2")
    Set wkNew = ThisWorkbook.Worksheets.Add

    wkNew.Name = "My New Worksheet"

    Dim newWkRow As Long
    newWkRow = 1

    Dim itemShortCode As String

    ' loop through wk2
    ' for each wk2.Cell found, call checkForMatch()
        ' store checkForMatch() value into variable
        itemShortCode = checkForMatch("my value", wk1)

        ' export to new worksheet
        exportToNewWorksheet wkNew, wk2, currentRowFromLoop, newWkRow, itemShortCode

        newWkRow = newWkRow + 1 ' the only reason for newWkRow is if you want to skip any
                                ' entries from WORKSHEET2. So it's best to keep this count separate
                                ' from your current loop row

    ' next
End Sub

Private Function checkForMatch(ByRef theValue As String, ByRef wk1 As Excel.Worksheet) As String
    ' PLEASE NOTE: wk1 does NOT need to match in the function definition to that of the
    '               variable defined in main()


    ' search for match from wk2 to wk1


    ' if found, return the Item_Short_Code
    ' otherwise return vbNullString

End Function

Private Sub exportToNewWorksheet(ByRef newWs As Excel.Worksheet, _
                                ByRef wk2 As Excel.Worksheet, _
                                ByRef wk2Row As Long, _
                                ByVal newRow As Long, _
                                Optional ByVal Item_Short_Code As String = vbNullString)

    ' put data into new row. be sure to use the Enum to re-order the column as you like
    If (Item_Short_Code <> vbNullString) Then
        ' store data one way
        ' ...
    Else
        ' store data another way
        newWs.Cells(newRow, 1).Value = Item_Short_Code
        newWs.Cells(newRow, 2).Value = wk2.Cells(wk2Row, wks2Columns.Hostname).Value
        ' etc...
    End If
End Sub

我認為您可能會被這一切的語法所困擾。 我在您的代碼中看到的一些提示：

1. 完全限定范圍對象。 Cell對象始終引用活動工作表的單元格，如果您從其他工作表中運行了代碼，這將無濟於事。
2. Offset(0,0)不執行任何操作。 如果要設置范圍的值，只需使用.Value
3. 如果主表的所有列的最后一行都相同，則可以將最后一行存儲到變量中，並在后續的范圍集中使用它
4. 我認為您已經編程過，如果可以的話，可以直接通過在線找到的一些VBA教程進行編程。 即使您的期限很緊，也值得付出努力。

希望這可以幫助

Answer 2

適用於可能正在嘗試做同樣事情的任何人的工作代碼。 它不是很漂亮，但是可以。 感謝約瑟夫的所有幫助和建議！！！

Public Enum Assyst1Columns
    Section_Dept = 1
    City
    Building
    SVD_User_Name
    Item_Short_Code
    Item_Full_Name
    SUPPLIER_SC
    Serial_Number
    IP_Address
    Product_Class
    Product
    Item_Status
End Enum

Public Enum Inventory1Columns
    Hostname = 1
    Management_IP
    Device_Type
    Vendor
    Model
    Software_Version
    Serial_Number
    Location
    In_Site
End Enum
Public Sub main()
    Dim Assyst As Excel.Worksheet
    Dim Inventory As Excel.Worksheet
    Dim Output As Excel.Worksheet
    Set Assyst = ThisWorkbook.Worksheets("Assyst")
    Set Inventory = ThisWorkbook.Worksheets("Inventory")
    Dim InventoryItems As Range
    Sheet3.Cells.Clear

    Sheet3.Range("A1") = "Old Item Short Code"
    Sheet3.Range("B1") = "New Item Short Code"
    Sheet3.Range("C1") = "New Item Full Name"
    Sheet3.Range("D1") = "IP Address"
    Sheet3.Range("E1") = "Product Class"
    Sheet3.Range("F1") = "Supplier"
    Sheet3.Range("G1") = "Product"
    Sheet3.Range("H1") = "Version"
    Sheet3.Range("I1") = "Serial Num"

    Dim newWkRow As Long
    newWkRow = 2


    Set InventoryItems = Inventory.Range("A2", Inventory.Range("A65536").End(xlUp))
    ' loop through Inventory Worksheet
    For Each hname In InventoryItems

        ' for each cell found, call checkForMatch()
        ' store checkForMatch() value into variable
        itemShortCode = checkForMatch(hname, Assyst)

        ' export to new worksheet
        exportToNewWorksheet Assyst, Inventory, hname.Row, newWkRow, itemShortCode

        newWkRow = newWkRow + 1 ' the only reason for newWkRow is if you want to skip any
                                ' entries from WORKSHEET2. So it's best to keep this count separate
                                ' from your current loop row

    Next
End Sub

Private Function checkForMatch(ByVal hname As String, ByRef Assyst As Excel.Worksheet) As String
    ' PLEASE NOTE: hname does NOT need to match in the function definition to that of the
    '               variable defined in main()
    ' search for match from Inventory to Assyst
    Dim matches As Range
    Dim Assyst1Items As Range
    Set Assyst1Items = Assyst.Range("A4", Assyst.Range("L65536").End(xlUp))

    On Error Resume Next
    Set matches = Assyst1Items.Find(hname, LookIn:=xlValues, lookat:=xlWhole)

    ' if found, return the Item_Short_Code
    If Not matches = "" Then
        checkForMatch = matches.Row

    ' otherwise return vbNullString
    Else
        checkForMatch = vbNullString
    End If

End Function

Private Sub exportToNewWorksheet(ByRef Assyst As Excel.Worksheet, _
                                ByRef Inventory As Excel.Worksheet, _
                                ByRef hname As Long, _
                                ByVal newWkRow As Long, _
                                Optional ByVal itemShortCode As String)

    'store data that's old but update data with Inventory ws
    If itemShortCode = "" Then
        Sheet3.Cells(newWkRow, 2).Value = Inventory.Cells(hname, Inventory1Columns.Hostname).Value
        Sheet3.Cells(newWkRow, 3).Value = Inventory.Cells(hname, Inventory1Columns.Hostname).Value
        Sheet3.Cells(newWkRow, 4).Value = Inventory.Cells(hname, Inventory1Columns.Management_IP).Value
        Sheet3.Cells(newWkRow, 5).Value = Inventory.Cells(hname, Inventory1Columns.Device_Type).Value
        Sheet3.Cells(newWkRow, 6).Value = Inventory.Cells(hname, Inventory1Columns.Vendor).Value
        Sheet3.Cells(newWkRow, 7).Value = Inventory.Cells(hname, Inventory1Columns.Model).Value
        Sheet3.Cells(newWkRow, 8).Value = Inventory.Cells(hname, Inventory1Columns.Software_Version).Value
        Sheet3.Cells(newWkRow, 9).Value = Inventory.Cells(hname, Inventory1Columns.Serial_Number).Value
    Else
        ' store data that's new (doesn't match)
        Sheet3.Cells(newWkRow, 1).Value = Assyst.Cells(itemShortCode, Assyst1Columns.Item_Short_Code).Value
        Sheet3.Cells(newWkRow, 2).Value = Inventory.Cells(hname, Inventory1Columns.Hostname).Value
        Sheet3.Cells(newWkRow, 3).Value = Inventory.Cells(hname, Inventory1Columns.Hostname).Value
        Sheet3.Cells(newWkRow, 4).Value = Inventory.Cells(hname, Inventory1Columns.Management_IP).Value
        Sheet3.Cells(newWkRow, 5).Value = Inventory.Cells(hname, Inventory1Columns.Device_Type).Value
        Sheet3.Cells(newWkRow, 6).Value = Inventory.Cells(hname, Inventory1Columns.Vendor).Value
        Sheet3.Cells(newWkRow, 7).Value = Inventory.Cells(hname, Inventory1Columns.Model).Value
        Sheet3.Cells(newWkRow, 8).Value = Inventory.Cells(hname, Inventory1Columns.Software_Version).Value
        Sheet3.Cells(newWkRow, 9).Value = Inventory.Cells(hname, Inventory1Columns.Serial_Number).Value
        ' etc...
    End If
End Sub