#excel #vba #sorting #copy #compare
Вопрос:
Я боролся с приведенной ниже задачей Excel VBA. В одной и той же рабочей книге есть два листа "Main"
и "Data"
. Информация "Data"
поступает из внешнего источника и "Main"
содержит отдельные данные комментария, которые должны находиться в той же строке, что и соответствующий идентификатор.
Задача здесь состоит в том, чтобы запустить макрос (VBA), который сравнивает идентификаторы в "Main"
с идентификаторами в том же первом столбце "Data"
. Если какие-либо идентификаторы отсутствуют, он должен скопировать их в "Data"
первую пустую строку "Main"
и отсортировать, "Main"
убедившись, что комментарии в следующей ячейке не отклоняются от соответствующего идентификатора. Прилагаются примеры скриншотов:
Комментарии:
1. Пожалуйста, добавьте код, который вы пробовали. Без кода вам очень трудно помочь .
Ответ №1:
Это руководство, а не ответ
Попробуйте использовать такой код;
MyListofNewValues = ""
for each TestRow in Sheets("Data").UsedRange.Rows
.... get a value to test
for each CheckRow in Sheets("Main").UsedRange.Rows
.... Check a value here with the value above
.... IF Different (ie New) add it to MyListOfNewValues
next CheckRow
Next TestRow
' Now you have a list of values in Data but Not in Main
' You'll have to add those to main amp; sort
Возвращайтесь, когда вы что — то попробовали, показывая код, который вы пробовали, или опубликуйте код, который вы уже пробовали
Ответ №2:
Добрый день, коллеги, спасибо вам за ваше время и предложения. Мне удалось устранить неполадки с VBA, и я опубликую это здесь для всех, кому необходимо выполнить аналогичную задачу. С наилучшими пожеланиями всем и оставайтесь позитивными.`Суб-Сравнение()
'Set Ranges
With Worksheets("Data")
lastrow = .Cells(Rows.Count, "A").End(xlUp).Row
compar = .Range(.Cells(1, 1), .Cells(lastrow, 1))
End With
Worksheets("Main").Select
lastdata = Cells(Rows.Count, "A").End(xlUp).Row
datar = Range(Cells(1, 1), Cells(lastdata, 1))
indi = lastdata 1
'Logical Test
For j = 1 To lastrow
For i = 1 To lastdata
fnd = False
If datar(i, 1) = compar(j, 1) Then
' When Found
fnd = True
Exit For
End If
Next i
If Not (fnd) Then
For kk = 1 To 1
Cells(indi, kk) = compar(j, kk)
Next kk
indi = indi 1
End If
Next j
'Sort Result
ActiveWorkbook.Worksheets("Main").ListObjects("Table1").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Main").ListObjects("Table1").Sort.SortFields.Add2 _
Key:=Range("Table1[[#All],[ID]]"), SortOn:=xlSortOnValues, Order:= _
xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Main").ListObjects("Table1").Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
ActiveWorkbook.Save
End Sub `