Excel VBA 比较多行的值并执行附加代码答案

【问题标题】：Excel VBA compare values on multiple rows and execute additional codeExcel VBA 比较多行的值并执行附加代码
【发布时间】：2023-02-06 20:46:57
【问题描述】：

我有以下任务：我的文档中有字段，需要比较它们的组合，如果它们相同，则需要更新同一行上的另一个字段。

到目前为止，我在数组中添加值（跳过第一行作为标题，因此 iNum = 2），每列使用 select 语句，并每行连接它们以进行比较。

Dim conc As Range                               'Concatenated fields
Dim iconc() As Variant

ReDim iconc(UBound(iMatn) - 1, 1)

For iNum = 2 To UBound(iMatn)
                
    iconc(iNum - 1, 1) = iMatn(iNum, 1) & iVendr(iNum, 1) & iInd1(iNum, 1) & iInd2(iNum, 1)    'Current concatenation

    Select Case iNum - 1
    
    Case 2:                     'Compare two records
    
        If iconc(iNum - 2, 1) = iconc(iNum - 1, 1) Then         'Compare first and second records
            'Execute code to update the two fields from Extra field column
        End If

    Case 3:                     'Compare three records
    
        If AllSame(iconc(iNum - 3, 1), iconc(iNum - 2, 1), iconc(iNum - 1, 1)) Then
            'Execute code to update the three fields from Extra field column
        End If

我遍历串联的每个值，并比较它是否与前面的 Case 语句相同（我不希望超过 4 或 5 个相同，即使可能有几百行）。因此我面临两个问题：

如果有 3 个相等的值，例如，代码首先跳转到 2 的情况。我怎样才能让它跳到最大值？
需要在已经检查过的行之后恢复检查。例如。如果前两个相同，代码应该从第三个开始检查；基本上从找到的任何重复行的最后一行开始。
Example

图片：代码需要返回有 3 个相等的行（第 2 到 4 行），更新“额外字段”列中的相应单元格，进一步处理（从第 5 行开始），返回有 2 个相等的行（第 6 行和 7)，再次更新与上面相同的内容，继续（从第 8 行开始）等。

任何帮助将不胜感激，因为我遇到了这个问题。

谢谢你们。

【问题讨论】：

标签： arrays excel vba compare excel-2010

【解决方案1】：

为了确定每个组中有多少，为了决定您将如何更新额外字段列，我将使用字典和集合对象。

例如：

'Set reference to Microsoft Scripting Runtime
'    (or use late-binding)

Option Explicit

Sub due()
  Dim myDict As Dictionary, col As Collection
  Dim i As Long, v As Variant
  Dim sKey As String

'there are more robust methods of selecting the table range
'depending on your actual layout
Dim rTable As Range
Set rTable = ThisWorkbook.Worksheets("sheet2").Cells(1, 1).CurrentRegion

Dim vTable As Variant
vTable = rTable

Set myDict = New Dictionary
For i = 2 To UBound(vTable)
    sKey = vTable(i, 1) & vTable(i, 2) & vTable(i, 3) & vTable(i, 4)
    Set col = New Collection
    If Not myDict.Exists(sKey) Then
        col.Add rTable(i)
        myDict.Add Key:=sKey, Item:=col
    Else
        myDict(sKey).Add (rTable(i))
    End If
Next i

For Each v In myDict.Keys
    Debug.Print v, myDict(v).Count
Next v

End Sub

1234V22341212  3 
1234v22351215  1 
2234v22361515  2 
2234v22361311  1

虽然，我可能会使用 Power Query（在 Windows Excel 2010+ 和 365 中可用），它可以轻松地按四列分组并返回一个计数。然后，您可以根据该计数添加一个新列。

【讨论】：