Сравните два списка и обновите недостающие данные с помощью Excel VBA

#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  `