Ir ao conteúdo
  • Cadastre-se

rafaelnd

Membro Júnior
  • Posts

    1
  • Cadastrado em

  • Última visita

Reputação

0
  1. 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.

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

×
×
  • Criar novo...