在工作表中搜索相似行以将 Excel VBA 组合在一起

Question

我有一个工作表，其标题列在顶行中。我还在下面的行中列出了数据。该数据将保持分组为一行，并且不能更改相对于彼此的位置。然而，整排可以自由移动。每个标题描述下面行的数据类型。

我希望能够：

1. 告诉宏在哪一列中查找以对行进行分组。为了方便起见，我们将其称为Col D
2. “浏览整个工作表”。
3. 移动相似的行，以便将它们分组在一起。***
4. 将组添加到选择

*注意，我还将在 Z 列中用整数标记组，以显示该组是一个组

我遇到的问题是以下问题我的子 FindRow 的行：

ActiveSheet.Range(curRange).Resize (resizeRng)

Dubug 说 curRange = "Elevator" 这是单元格的值，但不是范围，但我在上面定义了它：

inRange = "A" & rngStart & ":" & Mid(alphabet, totHdrLngth, 1) & belowRowCount
Set curRange = ActiveSheet.Range(inRange)

作为参考，我解释了下面的整体代码：

CreateGroup - 检查后续行是否有Col D 中的值相同。如果是，则将该组标记为唯一整数，并增加选择。如果没有，则调用 FindRow。

FindRow - 在整个工作表中搜索在Col D 中具有相同值的行(row1)。如果找到，则调用 rowSwapper 将找到的行 (row2) 与 row1 下面的行交换。

RowSwapper - 函数接受两个行号并交换它们。

这是子 CreateGroup：

Public Sub CreatGroup()
Dim letterCount As Integer
Dim letString, label, inRange As String
Dim rowSelect, marker, rowStart, rowCount, rngStart, count As Long

'Predefine necessary variables
marker = 1
rowCount = 2 'Start at  row 2, excluding header
rowStart = 2 'For range reference to create group
belowRowCount = 3 'start below rowCount
isGroup = False
count = 1

'Loop through each cell in column D to determine if consecutive metrics have the same value
'If true, while loop sorts each series of consecutive metrics individually
Do
    curCellVal = ActiveSheet.Range("D" & rowCount).Value  'Returns value rowCount(th) row of "Metric" column
    nextCellVal = ActiveSheet.Range("D" & belowRowCount).Value 'Returns the value of the row under rowCount
    marker = 1
    resizeRng = 0

    'Makes a cell selection while cell values in column 4 are equal
    If curCellVal = nextCellVal Then '<<<NECESSARY?
        isGroup = True   'Designates group has been found
        If resizeRng = 0 Then
            rngStart = rowCount
        End If
        'rowStart = ActiveSheet.Row

        'Resize selection to include cell with same metric name
        inRange = "A" & rngStart & ":" & Mid(alphabet, totHdrLngth, 1) & belowRowCount
        Set curRange = ActiveSheet.Range(inRange)

        'Establish place holder in col "Z" (empty) to track groups
        ActiveSheet.Range("Z" & rowCount).Value = marker
        ActiveSheet.Range("Z" & belowRowCount).Value = marker

        resizeRng = resizeRng + 1
        rowCount = rowCount + resizeRng
        belowRowCount = rowCount + 1

    ElseIf curCellVal <> nextCellVal Then 'And isGroup = True Then

        FindRow rowCount

        'Re-establish rowCount to account for cells that may have been added to group
        rowCount = rowCount + resizeRng
        belowRowCount = rowCount + 1
    Else
        rowCount = rowCount + 1
        belowRowCount = rowCount + 1
    End If

    'to prevent subsequent groups of metrics from being labeled together
    marker = marker + 1

    isGroup = False
Loop While rowCount <= totCount

End Sub

另外，作为额外参考，这些子是此处描述的更大程序的一部分： 对行组进行排序 Excel VBA 宏

让我知道你的想法...

Answer 1

如果你想获取单元格范围地址，你只需要输入 rng.Address 即可。只是指定您想要 rng 与说 rng.Value 相同（本质上）

至于行：

ActiveSheet.Range(curRange).Resize (resizeRng)

您可能想尝试

ActiveSheet.Range(curRange).Cells.Resize (resizeRng)

昨晚我在自己的一个小项目中使用了一些格式，并遇到了类似的错误。

希望有帮助。