我目前有一个宏,它将空白单元格组合在一起并忽略其中有值的单元格,我无法弄清楚如何更改它以便它使用特定值进行分组(150,155,130,115和110)确切地说。)
我的问题是如何更改代码,以便它不是对空白单元格进行分组,而是将单元格中的值组合在一起。
所以我想要这个
看起来像这样
澄清宏的作用:
它遍历每个单元格并检查值。如果它有价值,那么它会跳到下一个单元格。如果单元格没有值,则检查下一个单元格,如果发生相同的情况,则将这些单元格组合在一起。
代码:
Public Sub GroupCells()
Dim myRange As Range
Dim rowCount As Integer, currentRow As Integer
Dim firstBlankRow As Integer, lastBlankRow As Integer
Dim currentRowValue As String
Dim neighborColumnValue As String
Rows("1:2000").RowHeight = 15
Columns("A:N").ColumnWidth = 13
'select range based on given named range
Set myRange = Range("A7:A2000")
rowCount = Cells(Rows.Count, myRange.Column).End(xlUp).Row
firstBlankRow = 0
lastBlankRow = 0
'for every row in the range
For currentRow = 1 To rowCount
currentRowValue = Cells(currentRow, myRange.Column).Value
If (IsEmpty(currentRowValue) Or currentRowValue = "") Then
If firstBlankRow = 0 Then
firstBlankRow = currentRow
End If
ElseIf Not (IsEmpty(currentRowValue) Or currentRowValue = "") Then
If firstBlankRow = 0 Then
firstBlankRow = currentRow
ElseIf firstBlankRow <> 0 Then
lastBlankRow = currentRow - 1
End If
End If
If firstBlankRow <> 0 And lastBlankRow <> 0 Then
Range(Cells(firstBlankRow, myRange.Column), Cells(lastBlankRow, myRange.Column)).EntireRow.Select
Selection.Group
firstBlankRow = 0
lastBlankRow = 0
End If
Next
End Sub
答案 0 :(得分:1)
这应该这样做。您可以修改它以适应更详细的条件等:
Option Explicit
Sub Macro1()
Dim bBreak As Boolean
Dim i As Long
Dim lRow As Long
Dim rng As Range
Dim cell As Range
Dim WS As Worksheet
Dim dict As Object
Set WS = ActiveSheet
'I assume the values are in column A
With WS
lRow = .Cells(.Rows.Count, 1).End(xlUp).Row
End With
'Define a dictionary to store values that should be grouped
Set dict = CreateObject("scripting.dictionary")
dict.Add 150, ""
dict.Add 155, ""
dict.Add 130, ""
dict.Add 115, ""
dict.Add 110, ""
'Loop through the values in Column A and group them
For i = 1 To lRow
Set cell = WS.Cells(i, 1)
If dict.exists(cell.Value) Then 'cell value is among values store in the dict, so it should be grouped
If rng Is Nothing Then
Set rng = cell 'first cell with a value to be grouped
Else
Set rng = Application.Union(rng, cell)
End If
Else 'cell is a breaker value
If rng Is Nothing Then 'there is nothing to be grouped, continue
'do nothing
Else 'this is the last cell of a range that should be grouped
rng.Rows.Group 'group only rows
Set rng = Nothing 'reset the range
End If
End If
Next i
'If the last cell is not a breaker, the last cells will not be grouped
If Not rng Is Nothing Then
rng.Rows.Group 'group only rows
End If
End Sub