收集用户input以在VBA代码中自定义图纸名称

我有一对夫妇的macros，从一个文件中的不同工作簿拉两张工作簿到一个工作簿，并逐行比较两个工作表的差异。 问题是，无论何时我比较新的工作表对，我必须更改VBA代码中的所有工作表引用。 有没有办法添加一个input或消息框要求两个新的名单的工作表？ 例如，一个盒子会popup，并说：“请input原始表格名称”，另一个会popup并说“请input新的表格名称”。 另外，有没有办法把这些macros组合起来尽可能less？

Sub GetSourceSheets() 'This macro will loop through excel files 'in a location and copy the their worksheets into the current workbook. 'Instructions: Replace the file path, which starts on the 8th line, with a file path to the folder 'that contains the two vendor site lists that you wish to compare. '!!!! Do not for get to place the back slash (\) at the end of the file path. !!!! End of Instructions Application.DisplayAlerts = False Path = "C:\Users\turner\Desktop\Excel_Con\Kevin\NA_Vendor\" Filename = Dir(Path & "*.xls") Do While Filename <> "" Workbooks.Open Filename:=Path & Filename, ReadOnly:=True For Each Sheet In ActiveWorkbook.Sheets Sheet.Copy After:=ThisWorkbook.Sheets(1) Next Sheet Workbooks(Filename).Close Filename = Dir() Loop Application.DisplayAlerts = True End Sub Sub RunCompare() 'Instructions: Replace North_American_Old with the original vendor site list sheet name and 'replace North_American_New with the new vendor site list sheet name you wish 'to compare to the original vendor site list sheet. '!!!!! Keep sheet names enclosed in quotations !!!! End of Instructions Call compareSheets("North_America_Old", "North_America_New") End Sub Sub compareSheets(shtNorth_America_Old As String, shtNorth_America_New As String) 'Instructions: Replace North_American_Old with the original vendor site list sheet name and 'replace North_American_New with the new vendor site list sheet name you wish 'to compare to the original vendor site list sheet. '!!!!! Keep sheet names enclosed in quotations and remember to keep "sht" at the beginning of the sheet name!!!! 'End of Instructions Dim mycell As Range Dim mydiffs As Integer 'For each cell in sheet2 that is not the same in Sheet1, color it yellow For Each mycell In ActiveWorkbook.Worksheets(shtNorth_America_New).UsedRange If Not mycell.Value = ActiveWorkbook.Worksheets(shtNorth_America_Old).Cells(mycell.Row, mycell.Column).Value Then mycell.Interior.Color = vbRed mydiffs = mydiffs + 1 End If Next 'Display a message box to demonstrate the differences MsgBox mydiffs & " differences found", vbInformation ActiveWorkbook.Sheets(shtNorth_America_New).Select End Sub 

将macros与input框进行比较

 Sub RunCompare() Dim sht1 As String Dim sht2 As String sht1 = Application.InputBox("Enter the first sheet name") sht2 = Application.InputBox("Enter the second sheet name") Call compareSheets("sht1", "sht2") End Sub Sub compareSheets(sht1 As String, sht2 As String) Dim mycell As Range Dim mydiffs As Integer 'For each cell in sheet2 that is not the same in Sheet1, color it yellow For Each mycell In ActiveWorkbook.Worksheets(sht2).UsedRange If Not mycell.Value = ActiveWorkbook.Worksheets(sht1).Cells(mycell.Row, mycell.Column).Value Then mycell.Interior.Color = vbRed mydiffs = mydiffs + 1 End If Next 'Display a message box to demonstrate the differences MsgBox mydiffs & " differences found", vbInformation ActiveWorkbook.Sheets(sht2).Select End Sub 

Answer 1

使用input框：

 Dim sht1 as String Dim sht2 as String sht1 = Application.InputBox("Enter the first sheet name") sht2 = Application.InputBox("Enter the second sheet name") 

但是采用这种方法，您需要捕捉错误：如果用户误拼了工作表名称等，或者他们从input框中取消了，等等

或者，与ListBox或ComboBox用户窗体来select工作表。 再一次，你需要做一些validation（用户不能在这两个列表中select相同的表格），但我将离开实际的用例来解决问题。

用两个combobox和一个命令button创build一个用户表单。

 Sub UserForm_Activate() Dim ws as Worksheet For each ws in ThisWorkbook.Worksheets Me.ComboBox1.AddItem ws.Name Me.ComboBox2.AddItem ws.Name Next End Sub Sub CommandButton1_Click() Call compareSheets(ComboBox1.Value, ComboBox2.Value) End Sub 

或者，只需select要比较的两个工作表，然后执行如下操作：

 Sub RunCompare() Dim selSheets as Sheets Set selSheets = ActiveWindow.SelectedSheets If selSheets.Count = 2 Then Call CompareSheets(selSheets(1).Name, selSheets(2).Name) Else: MsgBox "Please select TWO sheets to compare", vbInformation End If End Sub