Question

我写了一个宏，其中我需要将相同的三元组数据（在三列中）合并为一行，并对发生这些三元组的行进行计数。我写了这段代码，但是它错误地计算了行数。在此工作表的前两行中也有一个标题。

我已经尝试过此代码，但计数不正确：

Dim rw As Long
Dim lr As Long

lr = Rows.Count

For rw = Rows.Count To 3 Step -1

    If Cells(rw, 1).Value2 <> Cells(rw - 1, 1).Value2 And _
       Cells(rw, 2).Value2 <> Cells(rw - 1, 2).Value2 And rw < lr And _
       Cells(rw, 3).Value2 <> Cells(rw - 1, 3).Value2 And rw < lr Then

         Cells(rw, 4) = Application.Count(Range(Cells(rw, 4), Cells(lr, 4)))
         Cells(rw + 1, 1).Resize(lr - rw, 1).EntireRow.Delete
         lr = rw + 1
    End If

Next rw

这是我的整个工作表：

日期；危急;生的; “ SFG；

12/04/2019; Y; 147833； 594673

12/04/2019; Y; 147833； 656555

12/04/2019; Y; 147833; 780319

12/04/2019; Y; 147833； 842201

12/04/2019; Y; 147833； 904083

12/04/2019; Y; 147833; 965965

12/04/2019; Y; 147833; 1027847

12/04/2019; Y; 147833; 1089729

12/04/2019; Y; 151753; 1151611

12/04/2019; Y; 151753; 1275375

12/04/2019; Y; 151753; 1337257

12/04/2019; Y; 151753; 1399139

12/04/2019; Y; 151753; 1461021

12/04/2019; Y; 151753; 1584785

我想要这个：

12/04/2019; Y; 147833; 8

12/04/2019; Y; 151753; 6

Answer 1

好像您想按前三列分组并通过计数进行汇总。
在运行之前保存工作簿的副本（以防万一）。下面的代码假定您的数据在名为"Sheet2"的工作表上（更改为您所用的名称）。
我们没有使用循环遍历单个行的方式，而是使用一些帮助器列（如果D列之后有数据，则可能会被帮助器列覆盖），然后按这些帮助器列中的值进行过滤。

Option Explicit

Private Sub GroupByFirstThreeColumnsAndCount()

    With ThisWorkbook.Worksheets("Sheet2")
        On Error Resume Next
        .ShowAllData
        On Error GoTo 0

        Dim lastRow As Long
        lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row

        With .Range("F3:F" & lastRow)

            ' Add groupByKeys
            .Formula = "=A3&""|""&B3&""|""&C3" ' Newer versions of Excel have TEXTJOIN. Use instead, if you have it.

            ' Add total count
            .Offset(0, -1).Formula = "=COUNTIF(" & .Address & "," & .Cells(1, 1).Address(rowabsolute:=False) & ")"

            ' Add cumulative/expanding count
            .Offset(0, 1).Formula = "=COUNTIF(" & .Cells(1, 1).Address & ":" & .Cells(1, 1).Address(rowabsolute:=False) & "," & .Cells(1, 1).Address(rowabsolute:=False) & ")"

            Dim rangeToFilter As Range
            Set rangeToFilter = .Offset(0, -1).Resize(, 3)
        End With

        rangeToFilter.Value2 = rangeToFilter.Value2
        rangeToFilter.Offset(-1, 0).Resize(rangeToFilter.Rows.Count + 1, rangeToFilter.Columns.Count).AutoFilter Field:=3, Criteria1:="<>1"

        Dim rowsToDelete As Range
        On Error Resume Next
        Set rowsToDelete = rangeToFilter.SpecialCells(xlCellTypeVisible).EntireRow
        On Error GoTo 0

        If Not (rowsToDelete Is Nothing) Then rowsToDelete.Delete
        rangeToFilter.AutoFilter

        .Columns("F:G").Clear
    End With
End Sub

给出我认为的预期输出：

vba问题与三列中具有相同数据的单元格合并成一行

1 个答案: