Позвольте мне предварить этот вопрос, сказав, что я абсолютно не понимаю, что я делаю, когда дело доходит до VBA и написания кода.
Я пытаюсь создать макрос, чтобы сделать следующее: 1) Нажмите кнопка, которая открывает диалоговое окно открытия нескольких файлов 2) Сохраните исходный файл как новое имя файла 3) Создайте вкладку результатов в новом имени файла.
Вышеупомянутые 3 у меня работают, хотя это может быть не так довольно.
Вот где я застрял: я хочу сравнить определенный c столбец в wb1 с определенным c столбцом в wb2. Столбцы будут разной длины, и они будут разной длины в двух книгах. Кроме того, два открытых файла всегда будут иметь разные имена. Затем я хочу вставить ячейки из wb1, которые не отображаются в wb2, в столбец A wb3 на странице результатов. Я опубликую то, что у меня есть, я думаю, что я близок, но я могу полностью ошибаться в этом!
Заранее благодарю за помощь !!!
Option Explicit
Sub opening_multiple_file()
Dim i As Integer
'Opening File dialog box
With Application.FileDialog(msoFileDialogFilePicker)
'Enabling multiple files select
.AllowMultiSelect = True
.Filters.Clear
'Only Excel files can be selected
.Filters.Add "Excel Files", "*.xls*"
If .Show = True Then
For i = 1 To .SelectedItems.Count
'Opening selected file
Workbooks.Open .SelectedItems(i)
Next i
End If
End With
Call save_as
End Sub
Sub save_as()
Dim wbk As Workbook
Set wbk = Workbooks("Anomaly List Compare Master.xlsm")
wbk.Sheets("Start").Activate
Dim FileName As Variant
'Displaying the saveas dialog box
FileName = Application.GetSaveAsFilename("Fault_Report_VEHICLENUMBER_MM_DD_YYYY", _
"Excel files,*.xls*", 1, "Select your folder and filename")
'Save the workbook
ActiveWorkbook.SaveAs FileName
Call CreateSheet
End Sub
Sub CreateSheet()
Dim ws As Worksheet
With ThisWorkbook
Set ws = .Sheets.Add(After:=.Sheets(.Sheets.Count))
ws.Name = "Results"
End With
Call Macro1
End Sub
Sub Macro1()
Dim bothcolumns As Range, i As Integer
Set bothcolumns = Selection
Dim wb1 As Workbook
Dim wb2 As Workbook
Dim wb3 As Workbook
For Each wb1 In Application.Workbooks
If wb1.Name Like "SV_Report*" Then
Set wb1 = wb1
Exit For
Else
MsgBox "There is no SV_Report file opened. Please try again..."
End
End If
For Each wb2 In Application.Workbooks
If wb2.Name Like "PPO*" Then
Set wb2 = wb2
Exit For
Else
MsgBox "There is no PPO file opened. Please try again..."
End
End If
For Each wb3 In Application.Workbooks
If wb3.Name Like "Fault_Report*" Then
Set wb3 = wb3
Exit For
Else
MsgBox "There is no Fault_Report file opened. Please try again..."
End
End If
Application.ScreenUpdating = False
For Each rngMyCell In wb1.Sheets("Test Fault Report").Range("A5:A500")
lngArrayCount = lngArrayCount + 1
ReDim Preserve varDataMatrix(1 To lngArrayCount)
varDataMatrix(lngArrayCount) = rngMyCell
Next rngMyCell
lngArrayCount = 0
For Each rngMyCell In wb2.Sheets("Static").Range("B2:B500")
lngArrayCount = lngArrayCount + 1
If rngMyCell.Value <> varDataMatrix(lngArrayCount) Then
GoTo QuitRoutinue
End If
Next rngMyCell
'If we get here both datasets have matched.
Set wb1 = Nothing
Set wb2 = Nothing
Set wb3 = ActiveWorkbook.Sheets("Results")
Application.ScreenUpdating = True
Erase varDataMatrix() 'Deletes the varible contents, free some memory
MsgBox "Data is the same.", vbInformation
Exit Sub
QuitRoutinue:
Set wb1 = Nothing
Set wb2 = Nothing
Set wb3 = ActiveWorkbook.Sheets("Results").Range("A2:A500")
Paste varDataMatrix()
Application.ScreenUpdating = True
Erase varDataMatrix() 'Deletes the varible contents, free some memory
End Sub