Numeração de linhas

[Diogo Antonio]

Boa noite

Gostaria da ajuda dos senhores para resolver o seguinte problema.

Estou montando uma planilha de orçamento de obra que tem a seguinte estrutura (exemplo):

- SERVIÇOS PRELIMINARES

    Compra do terreno

    Locação da obra

- FUNDAÇÃO

    Escavação manual

    Armadura 5mm

 

E assim por diante. O problema da numeração é que em uma "etapa" (ex: SERVIÇOS PRELIMINARES) o código seria "1" e os itens abaixo seria 1.1, 1.2......., seguindo este critério a etapa fundação seria "2" e os itens abaixo 2.1, 2.2........

Alguma idéia de como fazer esse código? Para diferenciar uma linha que está descrito a ETAPA de uma com SERVIÇO tenho uma coluna de verificação onde tenho "ET" se essa linha separador de etapa e "SE" para os serviços.

Desde já agradeço a atenção e aguardo ansiosamente para a solução deste problema.

 

Abraços

[Alyson Ronnan Martins]

Boa tarde @Diego Antonio.

Tem sim como fazer. Você tem uma planilha exemplo só para montar o código em cima dela (mais rápido assim)

[Diogo Antonio]

Boa tarde @Alyson Ronnan Martins, obrigado pela resposta

Segue anexo a planilha que preciso montar essa numeração.

Desde já, muito obrigado

https://drive.google.com/file/d/1qRbEDlJYqGSTYju7scQ8XTVhCbIc79bJ/view?usp=sharing

[Alyson Ronnan Martins]

Bom não sei se o código que eu fiz vai de encontro com o que estava planejando...

Fiz uma tabela para conter os campos que vão criar os formulário assim você marca com x o que vai precisar:

No formulário criei uma forma apenas para trazer as informações da tabela de opções.

Não fiz a formatação completamente por não saber se é dessa maneira que esta imaginando porém o código esta aberto para fazer as suas personalizações. E essa tabela pode ser substituída por uma formulário que vai preenchendo as informações e aparecendo as linhas no formulário.

Código:

Sub cFormCreateOptions()
Dim tCategory As String, idCategory As Long, tCategoryNew As String
Dim tSubCategory As String, idSubCategory As Long, tSubCategoryNew As String
Dim idOptions As Long
Dim rowSheetForm As Long, uRowSheetForm As Long
Dim rowSheetOptions As Long, uRowSheetOptions As Long
Dim shOpt As Worksheet

Set shOpt = Sheets("Opções")

With Sheets("Formulário")
    .Select
    uRowSheetForm = .Cells(Rows.Count, "G").End(xlUp).Row
    'uRowSheetForm = .Cells(Rows.Count, "A").End(xlUp).Row
    
    If uRowSheetForm > 5 Then
        Rows("6:" & uRowSheetForm).Delete shift:=xlUp
    End If


    rowSheetForm = 6

    uRowSheetOptions = shOpt.Cells(Rows.Count, "E").End(xlUp).Row
    For rowSheetOptions = 2 To uRowSheetOptions
        If shOpt.Cells(rowSheetOptions, "E").Value <> "" Then
        
            tCategoryNew = shOpt.Cells(rowSheetOptions, "A").Value
            If tCategory <> tCategoryNew Then
                tCategory = tCategoryNew
                idCategory = idCategory + 1
                idSubCategory = 0
                idOptions = 0
                
                .Cells(rowSheetForm, "A").Value = idCategory
                .Cells(rowSheetForm, "B").Value = tCategory
    
                
                .Range("A" & rowSheetForm & ":K" & rowSheetForm).Select
                With Selection.Interior
                    .Pattern = xlSolid
                    .PatternColorIndex = xlAutomatic
                    .ThemeColor = xlThemeColorLight1
                    .TintAndShade = 0.499984740745262
                    .PatternTintAndShade = 0
                End With
                
                rowSheetForm = rowSheetForm + 1
                
            End If
            
            tSubCategoryNew = shOpt.Cells(rowSheetOptions, "B").Value
            If tSubCategoryNew <> tSubCategory Then
                tSubCategory = tSubCategoryNew
                idSubCategory = idSubCategory + 1
                idOptions = 0
                
                If tSubCategory <> "" Then
                    .Cells(rowSheetForm, "A").Value = idCategory & "." & idSubCategory
                    .Cells(rowSheetForm, "B").Value = tSubCategory
                    
                    .Range("A" & rowSheetForm & ":K" & rowSheetForm).Select
                    With Selection.Interior
                        .Pattern = xlSolid
                        .PatternColorIndex = xlAutomatic
                        .ThemeColor = xlThemeColorDark1
                        .TintAndShade = -0.349986266670736
                        .PatternTintAndShade = 0
                    End With
                    
                    rowSheetForm = rowSheetForm + 1
                Else
                    idSubCategory = 0
                End If
            End If
            
            idOptions = idOptions + 1
            .Cells(rowSheetForm, "A").Value = IIf(idSubCategory > 0, _
                                                    idCategory & "." & idSubCategory & "." & idOptions, _
                                                    idCategory & "." & idOptions)
            .Cells(rowSheetForm, "B").Value = shOpt.Cells(rowSheetOptions, "C").Value
            .Cells(rowSheetForm, "C").Value = shOpt.Cells(rowSheetOptions, "D").Value
            
            rowSheetForm = rowSheetForm + 1
        End If
    Next rowSheetOptions

    
End With

Range("A1").Select
Range("G" & rowSheetForm).Value = "TOTAL"
Range("H" & rowSheetForm).FormulaR1C1 = "=SUM(R6C:R[-1]C)"
End Sub

 

Link planilha: PLANILHA ORÇAMENTARIA-PADRÃO