rafaelnd
-
Posts
1 -
Cadastrado em
-
Última visita
Tipo de conteúdo
Artigos
Selos
Fabricantes
Livros
Cursos
Análises
Fórum
posts postados por rafaelnd
Sobre o Clube do Hardware
No ar desde 1996, o Clube do Hardware é uma das maiores, mais antigas e mais respeitadas comunidades 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
Macro que insira um rotulo de linha após comparação de dados
em Microsoft Office e similares
Postado
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.