通过 Excel VBA 比较两个列表并更新缺失的数据答案

【问题标题】：Compare two lists and update missing data through Excel VBA通过 Excel VBA 比较两个列表并更新缺失的数据
【发布时间】：2021-08-31 09:57:05
【问题描述】：

我一直在努力处理下面的 Excel VBA 任务。在同一个工作簿中有两个工作表"Main" 和"Data"。 "Data" 中的信息来自外部来源，"Main" 包含需要与相应 ID 保持在同一行的单个评论数据。

这里的任务是运行一个宏 (VBA)，它将 "Main" 中的 ID 与 "Data" 中同一第一列中的 ID 进行比较。如果缺少任何 ID，则应将它们从 "Data" 复制到 "Main" 的第一个空行并按 "Main" 排序，确保下一个单元格中的 cmets 不会偏离相应的 ID。附上截图示例：

【问题讨论】：

请添加您尝试过的代码。 Without code, it is very hard to help you.

标签： excel vba sorting copy compare

【解决方案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 & sort

当您尝试显示您尝试过的代码时返回 - 或发布您已经尝试过的代码

【讨论】：

【解决方案2】：

同事们好，感谢您的时间和建议。我设法对 VBA 进行了故障排除，并将其发布在此处，以供需要完成类似任务的任何人使用。向所有人致以最诚挚的问候并保持积极态度。`Sub Compare()

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

【讨论】：