匹配列以保留结果数据

【问题标题】：Matching columns to retain result data匹配列以保留结果数据
【发布时间】：2022-01-25 19:18:56
【问题描述】：

我在第 1 列中有所有样本 ID 的完整列表。

C 列显示已经过 pH 测试的样品（以及 D 列中的相应结果）

B 列是一个重复列表，它使用以下 VBA 代码插入空格：

Sub Listduplicates()

Dim rngA As Range
Set rngA = Range([A1], Cells(Rows.Count, "A").End(xlUp))
rngA.Offset(0, 1).Columns.Insert
With rngA.Offset(0, 1)
    .FormulaR1C1 = _
    "=IF(ISNA(MATCH(RC[-1],C[1],0)),"""",INDEX(C[1],MATCH(RC[-1],C[1],0)))"
    .Value = .Value
End With
End Sub

问题：我现在如何使 pH 结果（D 列）与 A 列中相应的样品 ID 相匹配？

【问题讨论】：

标签： excel vba

【解决方案1】：

以C列为键，D列为值来拟合一个字典，然后向下扫描A列，将字典中的值填充到C列和D列。

Sub Listduplicates()

   Dim ws As Worksheet
   Dim i As Long, lastrow As Long
   Dim dict As Object, key As String
   Set dict = CreateObject("Scripting.Dictionary")

   Set ws = ThisWorkbook.Sheets("All Data")
   With ws
       ' scan col C get results from column D
       lastrow = .Cells(Rows.Count, "C").End(xlUp).Row
       For i = 2 To lastrow
           key = Trim(.Cells(i, "C"))
           If dict.exists(key) Then
               MsgBox "Duplicate SampleID '" & key & "'", vbCritical, "Row " & i
               Exit Sub
           ElseIf Len(key) > 0 Then
               dict.Add key, .Cells(i, "D").Value2
           End If
       Next
       
       ' scan col A
       lastrow = .Cells(Rows.Count, "A").End(xlUp).Row
       For i = 2 To lastrow
           key = Trim(.Cells(i, "A"))
           If dict.exists(key) Then
               .Cells(i, "C") = key
               .Cells(i, "D") = dict(key)
           Else
               .Cells(i, "C") = ""
               .Cells(i, "D") = ""
           End If
       Next
   End With
   MsgBox "Done"
End Sub

【讨论】：