Excel VBA比较两个工作表并输出特定的单元格到一个新的
我一直在尝试几个小时来做到这一点，但不是在VBScript的Excel的专家，我想我需要一点帮助。
这就是我所反对的。 我有两个不同的工作表，其中包含一些相同的信息。
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中的“Item Short Code / Item Full Name / Serial”中find了“主机名”forms的WORKSHEET2，我想输出“sheet1.item short code”，然后从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
我怀疑有一个简单的方法来做到这一点。 据我所知，你想尝试在另一个工作表中的3个可能的列中的一个工作表中匹配一个值，然后将这两个工作表中的某些数据输出到一个新的工作表中。 我真的没有看到一个聪明，简单的方法来做到这一点。
不过，这里有一些build议。 原谅我陈述你已经知道的事情，因为它接缝你知道如何编程：
利用Enum来查找和重新sorting复制的数据
例：
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
使用枚举，可以存储如何在工作表中设置列，然后稍后使用它们轻松地使用枚举方法重新排列新的表。 很酷的是，如果Section Dept的WORKSHEET1列曾经移动到第2列，City移动到第1列，那么只需要重新sorting枚举和BOOM，就完成了代码的修改;）
把你的function分解成更小的任务
这绝对是一个复杂的任务，如果你把这个全部放在一个大的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
我想你可能会陷入这一切的语法。 从我在代码中看到的一些提示：
- 完全限定您的范围对象。
Cell对象始终引用活动工作表的单元格，如果从另一个表单中运行代码，则不会对您有所帮助。 -
Offset(0,0)不起任何作用。 只要使用.Value如果你想设置一个范围的值 - 如果主工作表对所有列都有相同的最后一行，则可以将最后一行存储到一个variables中，并在随后的范围集中使用
- 我认为你已经编程过，如果是的话，你可以直接通过在线发现的一些VBA教程。 即使您的期限很紧，也是值得的。
希望这可以帮助
对于任何可能试图做同样事情的人来说， 这不是漂亮，但它的作品。 严重信贷约瑟夫的所有帮助和build议！
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