在工作表中search类似的行以将Excel VBA组合在一起

我有一个工作表,标题列在最上面一行。 我也有数据列在下面的行。 这些数据将保持组合在一起,并且不能相对于彼此改变位置。 但整排可以自由移动。 每个标题描述了下面一行的数据types。

我希望能够:

  1. 告诉macros在哪一列查看组合行。 为了方便起见,我们称之为Col D
  2. 查看整个工作表。
  3. 移动相似的行,以便将它们组合在一起。
  4. 将组添加到select

*注意我也会用Z中的一个整数标记组来显示这个组是一个组

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

ActiveSheet.Range(curRange).Resize (resizeRng) 

Dubug说curRange =“电梯”,这是一个单元格的值,但不是一个范围,但我在上面定义:

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

作为参考,我将解释下面的总体代码:

CreateGroup – 检查后续行在Col D中是否具有相同的值。 如果是这样,它将该组标记为一个唯一的整数,并增加select。 如果不是FindRow被调用。

FindRow – 在整个工作表中searchCol D中具有相同值的行(row1) 。 如果find,则调用rowSwapper将find的行(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 

另外,为了更多的参考,这些subs是这里描述的一个更大的程序的一部分: 对行Excel VBAmacros进行sorting

让我知道你的想法…

如果你想获得单元格范围的地址,你只需要说rng.Address。 只要说明你想要rng和rng.Value是一样的(本质上)

至于这一行:

 ActiveSheet.Range(curRange).Resize (resizeRng) 

你可能想尝试

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

我昨天晚上在一个自己的小项目上玩了一些格式化,并遇到了类似的错误。

希望有所帮助。