2014-09-17 3 views
0

У меня есть несколько макросов, которые вытягивают два листа в одну книгу из разных книг в файле и сравнивают два листа подряд за разностями. Проблема в том, что всякий раз, когда я сравниваю новые пары листов, я должен изменить все ссылки на листы в коде VBA. Есть ли способ добавить окно ввода или сообщения с запросом на два новых имени листов? Например, появится одна коробка и скажет: «Пожалуйста, введите имя оригинального листа», а еще один, который появится и скажет: «Пожалуйста, введите новое имя листа». Кроме того, существует ли способ комбинировать тезисы с макросами как можно меньше?Соберите пользовательский ввод, чтобы настроить имена листов в коде VBA

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 

Сравнить макрокоманд с полями ввода

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 
+1

'Dim результат, как Variant' и' Result = Application.Inputbox (...) ' – 2014-09-17 13:17:12

+0

Спасибо за ответ! Я все еще не уверен, как связать поле ввода с кодом, представляющим исходный лист или лист, который я хочу сравнить с оригинальным листом. – user3242245

+0

'Dim North_America_Old as Variant' и North_America_Old = Application.Inputbox (« Введите имя старого листа »)'. Что-то вроде этого возможно? – user3242245

ответ

1

использовать InputBox:

Dim sht1 as String 
Dim sht2 as String 

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

Но при таком подходе, вы должны перехвата ошибок: если пользователь misseplled имя листа, и т. д., или если они отменят из поля ввода и т. д.

Alt ernative, UserForm с ListBox или ComboBox для выбора рабочих листов. Опять же, вам нужно выполнить некоторую проверку (пользователь не может выбрать один и тот же лист в обоих списках и т. Д.), Но я оставлю фактический вариант использования для вас.

Создайте пользовательскую форму с двумя комбинированными значками и кнопкой управления.

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 

В качестве альтернативы, просто выберите две рабочие таблицы, которые вы хотите сравнить, и сделать что-то вроде этого:

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 
+0

большое спасибо. Последняя альтернатива работает хорошо. Будет ли код входа в поле ввода вводиться в «RunCompare», «макрос CompareSheets» или оба? Как можно ввести код входа в поле ввода? – user3242245

+0

Да, вы должны включить метод ввода в процедуру «RunCompare». Поместите эти 4 строки перед 'Call compareSheets', затем измените строку' Call compareSheets (sht1, sht2) '. –

+0

Еще раз спасибо @DavidZemens. После включения кода окна ввода и изменения всех «North_America_Old» на «sht1» и «North_America_Old» на «sht2» в макросе compareSheets я получаю ошибку времени выполнения № 9 в этой строке кода «Для каждого mycell In ActiveWorkbook.Worksheets (shtsht2) .UsedRange' в макросе compareSheets. – user3242245

Смежные вопросы