如何比较excel（vba）中的行并插入另一列？

Question

我需要这样的东西。 This picture contains all what I need, I need to insert Automatically the Value column. 我将从对行进行排序开始，以帮助我将相同的值影响到相同的行。 我需要逐行比较（行到下一行），如果相同，我会影响它们相同的值（列值）。

Sub SortMultipleColumns()
// I'll start by sorting rows, to help me to affect the same value to the same rows
With ActiveSheet.Sort
     .SortFields.Clear
     .SortFields.Add Key:=Range("A1"), Order:=xlAscending
     .SortFields.Add Key:=Range("B1"), Order:=xlAscending
     .SortFields.Add Key:=Range("C1"), Order:=xlAscending
     .SortFields.Add Key:=Range("D1"), Order:=xlAscending
     .SetRange Range("A1", Range("D1").End(xlDown))
     .Header = xlYes
     .Apply
    End With
    Dim bothrows  As Range, i As Integer

    Set bothrows = Selection

    With bothrows
// here i need to compre rows and insert in the last column value start by 1++
        For i = 1 To .Rows.Count

            If Not StrComp(.Cells(1, i), .Cells(2, i), vbBinaryCompare) = 0 Then

                // here I need to do something

            End If

        Next i

    End With

End Sub

Answer 1

试试这个代码：

Sub SortMultipleColumns()
    
    'Declarations.
    Dim RngList As Range
    Dim RngRow As Range
    Dim RngCell As Range
    Dim DblCounter As Double
    Dim StrString01 As String
    Dim StrString02 As String
    
    'Setting RngList.
    Set RngList = Range("A1")
    Set RngList = Range(RngList, RngList.End(xlDown).End(xlToRight))
    Set RngList = RngList.Resize(RngList.Rows.Count - 1).Offset(1, 0)
    
    'Sorting RngList.
    With ActiveSheet.Sort
        .SortFields.Clear
        For Each RngCell In RngList.Rows(1).Cells
            .SortFields.Add Key:=RngCell, Order:=xlAscending
        Next
        .SetRange RngList
        .Header = xlYes
        .Apply
    End With
    
    'Covering each row of RngList.
    For Each RngRow In RngList.Rows
        
        'Setting variables.
        StrString01 = ""
        StrString02 = ""
        
        'Covering each cell in the given row.
        For Each RngCell In RngRow.Cells
            'Setting variables to the contents of the given row and to its previous one.
            StrString01 = StrString01 & RngCell.Value
            StrString02 = StrString02 & RngCell.Offset(-1, 0).Value
        Next
        
        'Checking if the two rows differs.
        If Not StrComp(StrString01, StrString02, vbBinaryCompare) = 0 Then
            DblCounter = DblCounter + 1
        End If
        
        'Reporting DblCounter.
        RngRow.Offset(0, RngRow.Columns.Count).Resize(1, 1) = DblCounter
        
    Next
    
End Sub

由于它适应给定列表的宽度，它意味着在列表中使用一次。如果您想多次使用它，您可以将RngList 的设置编辑为具有固定列数的列表。像这样：

    'Setting RngList.
    Set RngList = Range("A1")
    Set RngList = Range(RngList, RngList.End(xlDown).Offset(0,3)
    Set RngList = RngList.Resize(RngList.Rows.Count - 1).Offset(1, 0)

您也可以使用公式来获得相同的结果。单元格 E2 中的类似内容应该可以解决问题：

=IF(A2&B2&C2&D2=A1&B1&C1&D1,MAX(E$1:E1),MAX(E$1:E1)+1)