Come saltare le celle vuote su una macro VBA che crea raggruppamenti

Question

Ciao,

vorrei poter implementare la macro seguente inserendo la possibilità di saltare la creazione del raggruppamento quando trova delle celle vuote, passando quindi alla cella successiva e raggruppare solo se c'è un valore.

Sub sOutlineGrouping()

Set rngCurrent = Range("B8") 'arting cell to create grouping

Do While Not rngCurrent = ("B100000") ' "" '

If rngCurrent <> strPrevValue Then ' if range is different from previous value, it means grouping label has changed, so set the new starting row

lngStartRow = rngCurrent.Row + 1 ' the starting row must be incremented by 1, because to group data you must exclude the first row

End If

strPrevValue = rngCurrent ' store the current value in strPrevValue variable

Set rngCurrent = rngCurrent.Offset(1) ' move to next row

If rngCurrent <> strPrevValue Then ' if next row value is different from previous one, then it is time to group rows

lngEndRow = rngCurrent.Offset(-1).Row ' set ending row, moving back one row

Rows(lngStartRow & ":" & lngEndRow).Group ' finally, group rows

End If

Loop ' restart the loop

End Sub

Come posso fare?

è possibile inoltre applicare la stessa macro a tutti i fogli del file?

Grazie in anticipo

Answer 1

Ciao Matteo,

vorrei poter implementare la macro seguente inserendo la possibilità di saltare la creazione del raggruppamento quando trova delle celle vuote, passando quindi alla cella successiva e raggruppare solo se c'è un valore.

Sub sOutlineGrouping()

Set rngCurrent = Range("B8") 'arting cell to create grouping

Do While Not rngCurrent = ("B100000") ' "" '

If rngCurrent <> strPrevValue Then ' if range is different from previous value, it means grouping label has changed, so set the new starting row

lngStartRow = rngCurrent.Row + 1 ' the starting row must be incremented by 1, because to group data you must exclude the first row

End If

strPrevValue = rngCurrent ' store the current value in strPrevValue variable

Set rngCurrent = rngCurrent.Offset(1) ' move to next row

If rngCurrent <> strPrevValue Then ' if next row value is different from previous one, then it is time to group rows

lngEndRow = rngCurrent.Offset(-1).Row ' set ending row, moving back one row

Rows(lngStartRow & ":" & lngEndRow).Group ' finally, group rows

End If

Loop ' restart the loop

End Sub

Come posso fare?

è possibile inoltre applicare la stessa macro a tutti i fogli del file?

Prova qualcosa del genere:

• Alt+F11 per aprire l'editor di VBA
• Alt+IM per inserire un nuovo modulo di codice
• Nel nuovo modulo vuoto, incolla il seguente codice:

'========>>

Option Explicit

'-------->>

Public Sub Tester()

Dim WB As Workbook 

Dim SH As Worksheet 

Dim i As Long, r As Long 

Dim iRows As Long 

Const iPrimaRiga As Long = 8 

Set WB = ThisWorkbook 

For Each SH In WB.Worksheets 

    With SH 

        .UsedRange.ClearOutline 

        iRows = .Range("B" & .Rows.Count).End(xlUp).Row 

        For i = iPrimaRiga To iRows 

            r = 0 

            Do While .Range("B" & i + r).Value <> "" And Not IsEmpty(.Range("B" & i + r).Value) And .Range("B" & i + r).Value = .Range("B" & i + r - 1).Value 

                r = r + 1 

            Loop 

            .Range("B" & i & ":B" & i + r - 1).Rows.Group 

            i = i + r 

        Next i 

    End With 

Next SH 

End Sub

'<<========

• Alt+Q per chiudere l'editor di VBA e tornare a Excel.
• Salva il file con l'estensione xlsm
• Alt+F8 per aprire la finestra di gestione delle macro
• Seleziona Tester
• Esegui

===

Regards,

Norman

Answer 2

Hello Leon,

you've been very kind, but I can't seem to apply it to my code. Excel is not responding.

Can you send me the complete code integrate to mine?

thank very much

Answer 3

Hi. For example

Sub GroupRows()

Dim ws As Worksheet For Each ws In ThisWorkbook.Sheets With ws Dim lRow As Long lRow = 10000

Dim i As Long For i = lRow To 10 Step -1 If Not IsEmpty(. Cells(i, 2)) Then . Rows(i). EntireRow.Group End If Next i End With Next ws End Sub

You include it to the code so it loops to all sheets.

Answer 4

Hello Leon,

I’d like to understand how to create groupings in the range from B10 to B10000 only when there are values in the cell and not with empty cell.

Also, I would like to apply this macro to all sheets in the file, can you please explain how to add this to the macro?

Answer 5

Hello, I am Leonielhou, an Independent Advisor and a user like you, I am happy to help clarify any questions you may have.

Can you tell us what language you are using? So we can better understand the problem. It seems the system were not able to translate it properly. Thanks.