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

rafaelnd · 30 de julho de 2015

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