Я буду добр и предположу, что вы не знаете, с чего начать. Мы иногда предлагаем людям попробовать использовать макро-рекордер, чтобы получить первое представление о коде, который им нужен. К сожалению, проблема не в том, для чего вам поможет макрос-рекордер.
Сравнение двух списков, подобных этому, не самая простая проблема, которая может возникнуть в качестве первой проблемы. Я пытался сделать что-нибудь в несколько шагов, чтобы вы могли понять их. Проблема в том, что существует ряд возможных ситуаций, каждая из которых должна быть проверена и выполнена:
- Значение в листе 1, но не в листе 2. Получить новое значение из Sheet1.
- Значение в Листе2, но не в Листе1. Запись не совпадает. Получить новое значение из Sheet2.
- Значения совпадают. Получите новые значения как из Sheet1, так и из Sheet2.
- Sheet1 исчерпал значения до Sheet2. Запишите все оставшиеся значения на листе 2 как не совпадающие.
- В Sheet2 закончились значения. Готово.
Я объяснил все шаги, но я уверен, что вам нужно будет использовать F8, чтобы уменьшить код по одному утверждению за раз. Если вы наведите курсор на переменную, вы увидите ее значение.
Спросите, не понимаете ли вы, но сначала попробуйте F8. Я не буду отвечать на вопросы, если вы не скажете мне, что вы пытались и что пошло не так.
Option Explicit ' This means I cannot use a variable I have not declared
Sub Compare()
' Declare all the variables I need
Dim Row1Crnt As Long
Dim Row2Crnt As Long
Dim Row3Crnt As Long
Dim Row1Last As Long
Dim Row2Last As Long
Dim ValueSheet1 As Long
Dim ValueSheet2 As Long
Dim NeedNewValueSheet1 As Boolean
Dim NeedNewValueSheet2 As Boolean
With Sheets("Sheet1")
' This goes to the bottom on column D, then go up until a value is found
' So this finds the last value in column D
Row1Last = .Cells(Rows.Count, "D").End(xlUp).Row
End With
' I assume Row 1 is for headings and the first data row is 2
Row1Crnt = 2
With Sheets("Sheet2")
Row2Last = .Cells(Rows.Count, "F").End(xlUp).Row
End With
Row2Crnt = 2
' You do not say which column to use in Sheet 3 so I assume "H".
' You do not same in the column in Sheet 3 is empty so I place
' the values under any existing value
With Sheets("Sheet3")
Row3Crnt = .Cells(Rows.Count, "H").End(xlUp).Row
End With
Row3Crnt = Row3Crnt + 1 ' The first row under any existing values in column H
' In Sheet1, values are on rows Row1Crnt to Row1Last
' In Sheet2, values are on rows Row2Crnt to Row2Last
' In Sheet3, non-matching values are to be written to Row3Crnt and down
' In your questions, all the values are numeric and are in ascending order.
' This code assumes this is true for the real data.
' Load first values. This will give an error if the values are not numeric.
' If the values are decimal, the decimal part will be lost.
With Sheets("Sheet1")
ValueSheet1 = .Cells(Row1Crnt, "D").Value
End With
With Sheets("Sheet2")
ValueSheet2 = .Cells(Row2Crnt, "F").Value
End With
' Loop for ever. Code inside the loop must decide when to exit
Do While True
' Test for each of the possible situations.
If Row1Crnt > Row1Last Then
' There are no more values in Sheet1. All remaining values in
' Sheet2 have no match
With Sheets("Sheet3")
.Cells(Row3Crnt, "H").Value = ValueSheet2
Row3Crnt = Row3Crnt + 1
End With
'I need a new value from Sheet2
NeedNewValueSheet2 = True
ElseIf ValueSheet1 = ValueSheet2 Then
' The two values are the same. Neither are required again.
' Record I need new values from both sheets.
NeedNewValueSheet1 = True
NeedNewValueSheet2 = True
ElseIf ValueSheet1 < ValueSheet2 Then
' Have value in Sheet1 that is not in Sheet2.
' In the example in your question you do not record such values
' in Sheet3. That is, you do not record 1, 2, 3 and 4 which are
' in Sheet1 but not Sheet3. I have done the same.
'I need a new value from Sheet1 but not Sheet2
NeedNewValueSheet1 = True
NeedNewValueSheet2 = False
Else
' Have value in Sheet2 that is not in Sheet1.
' Record in Sheet3
With Sheets("Sheet3")
.Cells(Row3Crnt, "H").Value = ValueSheet2
Row3Crnt = Row3Crnt + 1
End With
'I need a new value from Sheet2 but not Sheet1
NeedNewValueSheet1 = False
NeedNewValueSheet2 = True
End If
' I have compared the two values and if a non match was found
' it has been recorded.
' Load new values as required
If NeedNewValueSheet1 Then
' I need a new value from Sheet1
Row1Crnt = Row1Crnt + 1
If Row1Crnt > Row1Last Then
' There are no more in Sheet1. Any remaining values
' in Sheet2 are not matched.
Else
With Sheets("Sheet1")
ValueSheet1 = .Cells(Row1Crnt, "D").Value
End With
End If
End If
If NeedNewValueSheet2 Then
' I need a new value from Sheet2
Row2Crnt = Row2Crnt + 1
If Row2Crnt > Row2Last Then
' There are no more in Sheet2. Any remaining
' values in Sheet1 are ignored
Exit Do
End If
With Sheets("Sheet2")
ValueSheet2 = .Cells(Row2Crnt, "F").Value
End With
End If
Loop
End Sub
Новый раздел в ответ на изменение исходного вопроса
Я не понимаю, что вы пытаетесь сделать, и я предполагаю, что вы внесли изменения в мой исходный код. Ниже я объясню утверждения, которые соответствуют вашему требованию. Вы должны быть в состоянии объединить их, чтобы создать желаемую процедуру.
Выпуск 1
Вы говорите, что столбец C теперь является столбцом, который вы хотите использовать для сравнения. Вы также говорите, что строки не в порядке возрастания, что предполагает мой код. Очевидное решение - отсортировать листы по столбцу C.
Я создал следующий код:
- Включение макро-рекордера.
- Выделение всего листа Sheet1, с указанием строки заголовка и сортировка по столбцу C.
- Выключение макро-рекордера.
Использование макро-рекордера - это самый простой способ узнать, как что-то сделать, но код нуждается в некоторой корректировке. Код, сохраненный устройством записи макросов:
Cells.Select
Selection.Sort Key1:=Range("C2"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Я делаю следующие изменения:
- Добавьте
With Sheets("Sheet1") перед этим кодом и End With после него. Сохраненный код сортирует активный лист. В моих изменениях указано, что я хочу отсортировать Лист1 в зависимости от того, какой лист активен.
- Объедините два оператора, удалив
.Select Selection. Я не хочу выбирать диапазон для сортировки, потому что это замедляет макрос.
- Поставьте точку перед
Cells и Range. Это связывает их с заявлением «С».
- Наконец я заменяю
Header:=xlGuess на Header:=xlYes.
Результат:
With Sheets("Sheet1")
.Cells.Sort Key1:=.Range("C2"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
End With
Выберите Справка в редакторе VBA и найдите «метод сортировки». Вы получите несколько результатов, одним из которых будет «Метод сортировки». Это объяснит, каковы все другие параметры. Тем не менее, вам, вероятно, не нужно. Если вы отсортировали Sheet1 так, как хотите, остальные параметры будут такими, как вам нужно.
Сделайте копию и замените Лист1 на Лист2, чтобы получить:
With Sheets("Sheet1")
.Cells.Sort Key1:=.Range("C2"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
End With
With Sheets("Sheet2")
.Cells.Sort Key1:=.Range("C2"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
End With
Поместите этот новый код сразу после последней из тусклых отметок.
Выпуск 2
Первоначально вы хотели использовать столбец D на листе 1 и столбец F на листе 2. Теперь вы хотите использовать столбец C на обоих этих листах.
Заменить все ссылки на "D" и "F" на "C".
Выпуск 3
Теперь вы хотите скопировать 17 столбцов из Sheet2 в Sheet3. Вы не говорите, какие 17 столбцов в Sheet2 вы хотите скопировать или какие 17 столбцов в Sheet3 должны получить 17 столбцов. В следующем коде я предполагаю, что вы хотите скопировать столбцы от A до Q в 17 столбцов, начиная с столбцов B. Вам должно быть легко перейти на нужные вам столбцы.
Заменить:
With Sheets("Sheet3")
.Cells(Row3Crnt, "H").Value = ValueSheet2
Row3Crnt = Row3Crnt + 1
End With
от
With Sheets("Sheet3")
Worksheets("Sheet2").Range("A" & Row2Crnt & ":Q" & Row2Crnt).Copy _
Destination:=.Range("B" & Row3Crnt)
Row3Crnt = Row3Crnt + 1
End With
Резюме
Я думаю, что это те утверждения, которые вам нужны, чтобы изменить мою первоначальную процедуру, чтобы получить процедуру, которая вам требуется.