Excel VBA比较多行数值并执行额外代码

huangapple go评论64阅读模式
英文:

Excel VBA compare values on multiple rows and execute additional code

问题

我有以下的任务:
我的文档中有一些字段,它们的组合需要进行比较,如果它们相同,同一行的另一个字段需要更新。

到目前为止,我通过对每一列进行选择语句,跳过第一行作为标题(因此 iNum = 2),在数组中添加值并对每行进行串联以进行比较。

我逐个遍历串联值,并使用 Case 语句比较它是否与前面的值相同(即使有几百行,我也不指望会有超过4或5个相同的)。
因此我面临两个问题:

  1. 如果有3个相同的值,例如,代码首先跳转到2的情况。我如何让它跳转到最大值?
  2. 它需要在已经检查过的行之后继续检查。例如,如果前两行相同,代码应该从第三行开始检查;基本上是从位于任何重复行之后的最后一行开始检查。

示例

图片:代码需要返回有3行相同(第2到第4行),更新“额外字段”列中的相应单元格,然后继续(从第5行开始),返回有2行相同(第6和第7行),再次更新上述内容,然后继续(从第8行开始)等等。

任何帮助都将不胜感激,因为我卡在这个问题上了。

谢谢大家。

英文:

I have the following task:
There are fields in my document, the combination of which needs to be compared, and if they are the same, another field on the same rows need to be updated.

So far, I add the values in arrays (skipping the first row as header, thus iNum = 2) with select statements per column and concatenate them per row for the comparison.

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

I go through each value of the concatenation and compare if its the same as the previous ones with Case statement (I don't expect more than 4 or 5 to be the same, even though there could be a couple hundred of lines).
Thus I face two issues:

  1. If there are 3 equal values, for example, the code first jumps to the case for 2. How can I make it so that it skips to the maximum value?
  2. It needs to resume checking after the rows that were already checked. E.g. if the first two are the same, the code should start checking from the third one; basically to start at from the line after the last of any duplicate ones that are located.

Example

Image: the code needs to return that there are 3 equal rows (lines 2 to 4), update the respective cells on the "Extra field" column, proceed further (from line 5), return that there are 2 equal rows (lines 6 and 7), update the same as above again, proceed further (from line 8) etc.

Any help will be highly appreciated as I am stuck with this problem.

Thank you all.

答案1

得分: 0

为了确定每个组中有多少个元素,以决定如何更新额外字段列,我会使用字典和集合对象。

例如:

' 设置对Microsoft Scripting Runtime的引用
'(或者使用late-binding)

Option Explicit

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

  ' 根据实际布局,有更健壮的选择表格范围的方法
  ' 并且如果原始范围包括“额外字段”列或不包括,代码也会有所不同
  ' 以下代码假设原始数据中不包括它

  Set rTable = ThisWorkbook.Worksheets("sheet2").Cells(1, 1).CurrentRegion

  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 Item:=WorksheetFunction.Index(vTable, i, 0)
          myDict.Add Key:=sKey, Item:=col
      Else
          myDict(sKey).Add Item:=WorksheetFunction.Index(vTable, i, 0)
      End If
  Next i

  For Each v In myDict.Keys
      Select Case myDict(v).Count
          Case 2
              Debug.Print v, "Do update for two rows"
          Case 3
              Debug.Print v, "Do update for three rows"
          Case Else
              Debug.Print v, "No update needed"
      End Select
  Next v

End Sub

=>

1234V22341212 Do update for three rows
1234v22351215 No update needed
2234v22361515 Do update for two rows
2234v22361311 No update needed

尽管如此,我可能会使用Power Query(适用于Windows Excel 2010+和365),它可以轻松地按四个列进行分组并返回计数。然后,您可以根据该计数添加一个新列。

不知道您要更新的“额外字段”的性质以及对于2、3、4等情况之间的差异,无法提供任何与此目的相关的代码。

通常,您会执行以下操作:

  • 展开每个字典项的数组
  • 如果还没有额外列,则添加额外列
  • 执行更新
  • 将结果数组添加到预定义的结果数组
  • 将结果数组写回工作表

请注意,使用VBA数组处理方法与重复访问工作表相比,执行速度更快,但代码较长。

英文:

To determine how many are in each group, in order to decide how you will update the extra fields column, I would use a Dictionary & Collection object.

eg:

'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
  Dim rTable As Range
  Dim vTable As Variant, vResults As Variant

'there are more robust methods of selecting the table range
'depending on your actual layout
'And code will also make a difference if the original range includes
'  or does not include the "Extra Field" Column
' Code below assumes it is NOT included in original data

Set rTable = ThisWorkbook.Worksheets("sheet2").Cells(1, 1).CurrentRegion

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 Item:=WorksheetFunction.Index(vTable, i, 0)
        myDict.Add Key:=sKey, Item:=col
    Else
        myDict(sKey).Add Item:=WorksheetFunction.Index(vTable, i, 0)
    End If
Next i

For Each v In myDict.Keys
    Select Case myDict(v).Count
        Case 2
            Debug.Print v, "Do update for two rows"
        Case 3
            Debug.Print v, "Do update for three rows"
        Case Else
            Debug.Print v, "No update needed"
    End Select
Next v

End Sub

=>

1234V22341212 Do update for three rows
1234v22351215 No update needed
2234v22361515 Do update for two rows
2234v22361311 No update needed

Although, I would probably use Power Query (available in Windows Excel 2010+ and 365) which can easily group by the four columns and return a count. You can then add a new column depending on that count.

Not knowing the nature of your updating Extra Field and the difference between what happens for 2, 3, 4, ... the same, it is not possible to supply any code for that purpose.

In general, you would

  • expand the array for each dictionary item
  • Add the extra column if it's not already there
  • Do the update
  • Add that to a pre-dimensioned results array
  • Write the results array back to the worksheet

Note that this method of working with VBA arrays will execute an order of magnitude faster than doing repeated worksheet accessing, but the code is longer.

答案2

得分: 0

如果您使用向下查看下一行(而不是向上查看),您可以确定组的结束并相应地处理。

英文:

If you use a look ahead to the next row (rather than look behind) you can determine the end of the group and process accordingly.

Option Explicit

Sub CompareRows()

    Dim ws As Worksheet, ar, arExtra
    Dim lastrow As Long, n As Long, i As Long, k As Long
    Dim s As String, sNext As String, rng As Range, iColor As Long
    
    Set ws = ThisWorkbook.Sheets("Sheet1")
    With ws
        lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
        ar = .Range("A1:D1").Resize(lastrow)
        n = 1
        For i = 1 To UBound(ar)
        
            ' look ahead to next line
            If i = UBound(ar) Then
                sNext = ""
            Else
                sNext = ar(i + 1, 1) & "_" & ar(i + 1, 2) & _
                "_" & ar(i + 1, 3) & "_" & ar(i + 1, 4)
            End If
               
            If i > 1 Then ' skip header
                ' increment count if matched
                If sNext = s Then
                     n = n + 1
                
                ' process group using counter n
                Else
                    If n >= 2 Then
                        ' first row of group
                        Set rng = .Cells(i, "E").Offset(1 - n)
                           
                        If n >= 3 Then
                            iColor = rgb(128, 255, 128) ' green
                        Else
                            iColor = rgb(255, 255, 128) ' yellow
                        End If
                            
                        'code to update n rows in Extra column
                        rng.Resize(n).Value = n
                        rng.Offset(, -4).Resize(n, 5).Interior.color = iColor
                        
                        k = k + 1 ' group count
                    End If
                    n = 1
                End If
            End If
            s = sNext
        Next
    End With
    MsgBox k & " groups found", vbInformation

End Sub


</details>



huangapple
  • 本文由 发表于 2023年2月6日 18:06:23
  • 转载请务必保留本文链接:https://go.coder-hub.com/75359862.html
匿名

发表评论

匿名网友

:?: :razz: :sad: :evil: :!: :smile: :oops: :grin: :eek: :shock: :???: :cool: :lol: :mad: :twisted: :roll: :wink: :idea: :arrow: :neutral: :cry: :mrgreen:

确定