Ir ao conteúdo
  • Cadastre-se
rafaelnd

Macro que insira um rotulo de linha após comparação de dados

Recommended Posts

Boa tarde pessoal. 

 

Andei verificando aqui no fórum pra ver se achava algo parecido com o meu problema porém não achei. 

 

Estou criando no meu serviço uma planilha que ao importar uma base de dados em .txt ele edite e calcule essas informações. Até ai já criei as macros e elas estão funcionando normalmente. Só que ao final desses cálculos esse relatório tem que criar um rotulo de linha e a cada mudança de valores e código da peça eu tenho que inserir um rotulo de linha para que se crie um subtotal que cada peça.

 

 

Ex:

COD ITEM PREÇO

1010 PORCA 3,10

1010 PARAFUSO 3,10

COD ITEM PREÇO

1011 PORCA 3,15

1011 PARAFUSO 3,15

Espero que vocês entendam o que eu quis dizer com essa "tabela". Pois não consegui editar direito.

Para que eu crie um subtotal na próxima etapa seria necessário eu colocar os rótulos de linha a cada mudança de COD e PREÇO. Que a macro inserisse isso a cada mudança. Independente da quantidade de linhas na tabela da tabela.

 

Segue o código. Consegui dar uma estruturada para um melhor entendimento.

 

 

Sub Subtotal()

'

 'Subtotal Macro

 

 'Atalho do teclado: Ctrl+Shift+T

 

    'ActiveWindow.SmallScroll Down:=-15

    'ActiveWindow.Zoom = 90

    'ActiveWindow.Zoom = 80

    'ActiveWindow.SmallScroll Down:=-39

    'Rows("1:1").Select

    'Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove

    

    Range("A1").Select

    ActiveCell.FormulaR1C1 = "COD"

    

    Range("B1").Select

    ActiveCell.FormulaR1C1 = "MAT.PRIMA"

    

    Range("C1").Select

    ActiveCell.FormulaR1C1 = "MAT.PARASMO"

    

    Range("D1").Select

    ActiveCell.FormulaR1C1 = "DESCRIÇÃO"

    

    Range("E1").Select

    ActiveCell.FormulaR1C1 = "PREÇO"

    

    Range("F1").Select

    ActiveCell.FormulaR1C1 = "P.LIQUIDO"

    

    Range("G1").Select

    ActiveCell.FormulaR1C1 = "P.BRUTO"

    

    Range("H1").Select

    ActiveCell.FormulaR1C1 = "A"

    

    Range("I1").Select

    ActiveCell.FormulaR1C1 = "B"

    

    Range("J1").Select

    ActiveCell.FormulaR1C1 = "C"

    

    Range("K1").Select

    ActiveCell.FormulaR1C1 = "QTD.FATOR"

    

    Range("L1").Select

    ActiveCell.FormulaR1C1 = "P.LIQ*QTD.FATOR"

    

    Range("M1").Select

    ActiveCell.FormulaR1C1 = "P.BRUTO*QTD.FATOR"

    

    Range("N1").Select

    Columns("A:M").EntireColumn.AutoFit

    

    Range("A1:M1").Select

    Selection.Font.Bold = True

    Range("A1").Select

    'fim cabeçalho

    

    'Até aqui tudo bem

    'Nessa parte queria que ao invés de dinamizar a planilha, nesse caso ela seleciona até a 260 linha, mais terão outros

    'relatórios que terá mais de 500 linhas.

    

    

    Columns("A:M").Select

    ActiveSheet.Sort.SortFields.Clear

    ActiveSheet.Sort.SortFields.Add Key:=Range("A2:A260") _

    , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortTextAsNumbers

    

        

    ActiveSheet.Sort.SortFields.Add Key:=Range("E2:E260") _

    , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal

      With ActiveWorkbook.ActiveSheet.Sort

    

 

    

    .SetRange Range("A1:M260")

        .Header = xlYes

        .MatchCase = False

        .Orientation = xlTopToBottom

        .SortMethod = xlPinYin

        .Apply

    End With

    

       

    

    Range("A1:M1").Select

    'forma manual que eu achei especificamente para esses dados

    

    Selection.Copy

    Rows("17:17").Select    'nesse caso ele vai inserir um rótulo de linha na linha 17 mais se a mudança de cod de peça e valores for na linha

    '30 por exemplo ele teria que identificar a mudança e inserir.

    

    Selection.Insert Shift:=xlDown

    Application.CutCopyMode = False

    

    Selection.Copy

    Rows("59:59").Select

    Selection.Insert Shift:=xlDown

    Application.CutCopyMode = False

    

    Selection.Copy

    Rows("61:61").Select

    Selection.Insert Shift:=xlDown

    Application.CutCopyMode = False

    

    Selection.Copy

    Rows("69:69").Select

    Selection.Insert Shift:=xlDown

    Application.CutCopyMode = False

    

    Selection.Copy

    Rows("94:94").Select

    Selection.Insert Shift:=xlDown

    Application.CutCopyMode = False

    

    Selection.Copy

    Rows("103:103").Select

    Selection.Insert Shift:=xlDown

    Application.CutCopyMode = False

    

    Selection.Copy

    Rows("108:108").Select

    Selection.Insert Shift:=xlDown

    Application.CutCopyMode = False

    

    Selection.Copy

    Rows("114:114").Select

    Selection.Insert Shift:=xlDown

    Application.CutCopyMode = False

    

    Selection.Copy

    Rows("116:116").Select

    Selection.Insert Shift:=xlDown

    Application.CutCopyMode = False

    

    Selection.Copy

    Rows("119:119").Select

    Selection.Insert Shift:=xlDown

    Application.CutCopyMode = False

    

    Selection.Copy

    Rows("124:124").Select

    Selection.Insert Shift:=xlDown

    Application.CutCopyMode = False

    

    Selection.Copy

    Rows("150:150").Select

    Selection.Insert Shift:=xlDown

    Application.CutCopyMode = False

    

    Selection.Copy

    Rows("185:185").Select

    Selection.Insert Shift:=xlDown

    Application.CutCopyMode = False

    

    Selection.Copy

    Rows("191:191").Select

    Selection.Insert Shift:=xlDown

    Application.CutCopyMode = False

    

    Selection.Copy

    Rows("193:193").Select

    Selection.Insert Shift:=xlDown

    Application.CutCopyMode = False

    

    Selection.Copy

    Rows("224:224").Select

    Selection.Insert Shift:=xlDown

    Application.CutCopyMode = False

    

    Selection.Copy

    Rows("248:248").Select

    Selection.Insert Shift:=xlDown

    Application.CutCopyMode = False

    

    Selection.Copy

    Rows("257:257").Select

    Selection.Insert Shift:=xlDown

    Application.CutCopyMode = False

    

    Selection.Copy

    Rows("262:262").Select

    Selection.Insert Shift:=xlDown

    Application.CutCopyMode = False

    

    Selection.Copy

    Rows("265:265").Select

    Selection.Insert Shift:=xlDown

    Application.CutCopyMode = False

    

    Selection.Copy

    Rows("267:267").Select

    Selection.Insert Shift:=xlDown

    Application.CutCopyMode = False

    

    Selection.Copy

    Rows("269:269").Select

    Selection.Insert Shift:=xlDown

    Application.CutCopyMode = False

    

    Selection.Copy

    Rows("272:272").Select

    Selection.Insert Shift:=xlDown

    Application.CutCopyMode = False

    

    Selection.Copy

    Rows("274:274").Select

    Selection.Insert Shift:=xlDown

    Application.CutCopyMode = False

    

    Selection.Copy

    Rows("276:276").Select

    Selection.Insert Shift:=xlDown

    Application.CutCopyMode = False

    

    Selection.Copy

    Rows("278:278").Select

    Selection.Insert Shift:=xlDown

    Application.CutCopyMode = False

    

    Selection.Copy

    Rows("282:282").Select

    Selection.Insert Shift:=xlDown

    Application.CutCopyMode = False

    

    Selection.Copy

    Rows("284:284").Select

    Selection.Insert Shift:=xlDown

    Application.CutCopyMode = False

    

    Selection.Copy

    Rows("287:287").Select

    Selection.Insert Shift:=xlDown

    Application.CutCopyMode = False

    

    Selection.Copy

    Application.CutCopyMode = False

    Range("A290").Select

 

 End Sub

    

    

Agradeço desde já. Pois já estou quebrando a cabeça faz um bom tempo.

Compartilhar este post


Link para o post
Compartilhar em outros sites

Crie uma conta ou entre para comentar

Você precisar ser um membro para fazer um comentário

Criar uma conta

Crie uma nova conta em nossa comunidade. É fácil!

Crie uma nova conta

Entrar

Já tem uma conta? Faça o login.

Entrar agora





Sobre o Clube do Hardware

No ar desde 1996, o Clube do Hardware é uma das maiores, mais antigas e mais respeitadas publicações sobre tecnologia do Brasil. Leia mais

Direitos autorais

Não permitimos a cópia ou reprodução do conteúdo do nosso site, fórum, newsletters e redes sociais, mesmo citando-se a fonte. Leia mais

×