Ir ao conteúdo
  • Cadastre-se

FSoares.FCS

Membros Plenos
  • Total de itens

    37
  • Registro em

  • Última visita

  • Qualificações

    N/D
  1. ok, obrigado.... que Deus abençoe.
  2. Boa noite Patropi, Na minha planilha não deu certo, pode me explicar... Obrigado mais uma vez.... PLANILHA -ASO 2018.xlsx adicionado 1 minuto depois mandei minha planilha, mas sou leigo no excel.....grato...
  3. Boa tarde, tenho uma coluna com varias datas e preciso contar a quantidade de meses em uma outra celular Segue um exemplo: Grato pela ajuda.
  4. Bom dia, Se existir o que deve ser feito? se na coluna C da planilha C.Custo as celulas e tiverem com planilhas criadas, não faz nada, só coloca uma msgbox "Existe todas planilhas" Se nao existir o que deve ser feito? não existindo pegar a celula na coluna C da planilha C.Custo e cira uma nova planilha com o nome da celula Grato pela sua resposta. adicionado 1 minuto depois Bom dia obrigado pela resposta, vai ajudar muito.
  5. Bom dia, Estou iniciando no excel VBA e estou precisando criar um marco onde possa procurar uma planilha (aba) dentro de uma pasta de trabalho ativa, tenho uma planilha (aba) com o nome de "Centro de Custo" onde tem vários centro de custo na coluna "C", a partir dai preciso procurar se o conteúdo da célula "C2", tem alguma planilha com o mesmo nome caso tenha, passe para linha de baixo indo até o final, caso não inclua uma nova planilha (aba) e altere o nome. C.Custo 1.1.0.101 1.2.0.101 1.3.0.101 2.1.0.101 2.1.0.201 2.1.0.202 2.1.0.203 2.1.0.204 Fico muito agradecido pela ajuda. Que Deus abençoe.
  6. Obrigado pela sua atenção, consegui resolver da forma abaixo: ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _ "RESUMO DE VENDAS!R1C1:R1048576C10", Version:=xlPivotTableVersion15). _ CreatePivotTable TableDestination:="", TableName:= _ "Tabela dinâmica2", DefaultVersion:=xlPivotTableVersion15
  7. Bom dia, Criei um macro para criar tabela dinâmica automaticamente só que quando executo gerar erro em tempo de execução "5" logo na primeira linha. Sub Macro6() ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _ "RESUMO DE VENDAS!R1C1:R1048576C10", Version:=xlPivotTableVersion15). _ CreatePivotTable TableDestination:="DINAMICA VENDAS!R1C1", TableName:= _ "Tabela dinâmica4", DefaultVersion:=xlPivotTableVersion15 Sheets("DINAMICA VENDAS").Select Cells(1, 1).Select ActiveWorkbook.ShowPivotTableFieldList = True With ActiveSheet.PivotTables("Tabela dinâmica4").PivotFields( _ "Nota Fiscal/Serie") .Orientation = xlRowField .Position = 1 End With With ActiveSheet.PivotTables("Tabela dinâmica4").PivotFields(" Vlr.Total") .Orientation = xlRowField .Position = 2 End With With ActiveSheet.PivotTables("Tabela dinâmica4").PivotFields(" Vlr.IPI") .Orientation = xlRowField .Position = 3 End With With ActiveSheet.PivotTables("Tabela dinâmica4").PivotFields("ST") .Orientation = xlRowField .Position = 4 End With ActiveSheet.PivotTables("Tabela dinâmica4").AddDataField ActiveSheet. _ PivotTables("Tabela dinâmica4").PivotFields(" Vlr.Total"), _ "Contagem de Vlr.Total", xlCount ActiveSheet.PivotTables("Tabela dinâmica4").AddDataField ActiveSheet. _ PivotTables("Tabela dinâmica4").PivotFields(" Vlr.IPI"), "Contagem de Vlr.IPI" _ , xlCount ActiveSheet.PivotTables("Tabela dinâmica4").AddDataField ActiveSheet. _ PivotTables("Tabela dinâmica4").PivotFields("ST"), "Contagem de ST", xlCount Range("B1").Select With ActiveSheet.PivotTables("Tabela dinâmica4").PivotFields( _ "Contagem de Vlr.Total") .Caption = "Soma de Vlr.Total" .Function = xlSum End With Range("B1").Select With ActiveSheet.PivotTables("Tabela dinâmica4").PivotFields( _ "Soma de Vlr.Total") .Caption = "valor total da vendas" .NumberFormat = "#.##0,00_);[Vermelho](#.##0,00)" End With Range("C1").Select With ActiveSheet.PivotTables("Tabela dinâmica4").PivotFields( _ "Contagem de Vlr.IPI") .Caption = "valor do ipi" .Function = xlSum .NumberFormat = "#.##0,00_);[Vermelho](#.##0,00)" End With Range("D1").Select With ActiveSheet.PivotTables("Tabela dinâmica4").PivotFields("Contagem de ST") .Caption = "valor do ST" .Function = xlSum .NumberFormat = "#.##0,00_);[Vermelho](#.##0,00)" End With ActiveSheet.PivotTables("Tabela dinâmica4").CalculatedFields.Add "Campo1", _ "=' Vlr.Total' +' Vlr.IPI' +ST", True ActiveSheet.PivotTables("Tabela dinâmica4").PivotFields("Campo1").Orientation _ = xlDataField Range("E1").Select ActiveSheet.PivotTables("Tabela dinâmica4").PivotFields("Soma de Campo1"). _ Caption = "valor total" Range("G1").Select End Sub Resumo de Vendas.rar
  8. Muito obrigado, que Deus lhe abençoe me ajudou muito.....
  9. Bom dia, Queria saber se a possibilidade de colocar barra de progresso ou outra coisa que ao iniciar a UserForm e clicar no botão "SIM", que fique identificando que a um processamento e o usuário não pense que o excel travou, sendo que a UserForm tem varias opções de funções, os que eu achei na internet trava o processamento... As funções demora alguns minutos. Desde já agradeço a ajuda. Anexei só duas funções que UserForm usar, pois tem mais e fica muito extensão aqui: Sub TBCUSTO() On Error GoTo Erro Application.DisplayAlerts = False Application.ScreenUpdating = False Dim resposta resposta = MsgBox("Deseja iniciar a separação dos centros de custos ...? ", vbYesNo) If resposta = vbNo Then Exit Sub End If 'Definr Planilhas Set B = Plan6 'Balancete Set W = Plan2 'C.custo W.Select W.Range("C2").Select pula_aba = W.Range("C2") Set Y = Sheets(pula_aba) Y.Select Y.Range("A1").Select aba = ActiveSheet.Name 'Estrutura de Repetição Do While W.Range("C2") <> " " 'Limpar planilha e Procura centro de custo W.Select retorno = Application.WorksheetFunction.VLookup(aba, W.Columns("D:D"), 1, False) W.Range("A2") = retorno Y.Select Cells.Select 'Range("A:K").Select Selection.Delete Shift:=xlUp 'Selection.ClearContents 'Filtrando pelo filtro avançado Range("A1").Select B.Columns("A:G").AdvancedFilter Action:=xlFilterCopy, _ CriteriaRange:=W.Range("A1:A2"), CopyToRange:=Range("A1"), _ Unique:=False Cells.Select Cells.EntireColumn.AutoFit Range("A1").Select SomaValor W.Select ActiveCell.Offset(1, 0).Select pula_aba = ActiveCell.Value If ActiveCell.Value = "" Then Exit Do End If Set Y = Sheets(pula_aba) Y.Select Y.Range("A1").Select aba = ActiveSheet.Name Loop ActiveWorkbook.Save Erro: MsgBox (" Chegou ao último Centro de Custo... ( " & pula_aba & " ) - Se não erro no nome da Aba !!") MsgBox ("Fim do Processo... Tenha um ótimo dia....") Application.DisplayAlerts = True Application.ScreenUpdating = True End Sub Sub RAZAO_CUSTO() On Error GoTo Erro Application.DisplayAlerts = False Application.ScreenUpdating = False Dim resposta resposta = MsgBox("Deseja iniciar a separação dos centros de custos ...? ", vbYesNo) If resposta = vbNo Then Exit Sub End If 'Definir Planilhas Set B = Plan229 'Razão Set W = Plan2 'C.Custo W.Select W.Range("C2").Select pula_aba = W.Range("C2") Set Y = Sheets(pula_aba) Y.Select Y.Range("A1").Select aba = ActiveSheet.Name 'Estrutura de Repetição Do While W.Range("C2") <> " " 'Limpar planilha e Procura centro de custo W.Select retorno = Application.WorksheetFunction.VLookup(aba, W.Columns("D:D"), 1, False) W.Range("A2") = retorno Y.Select Cells.Select Selection.Delete Shift:=xlUp 'Filtrando pelo filtro avançado Range("A1").Select B.Columns("A:M").AdvancedFilter Action:=xlFilterCopy, _ CriteriaRange:=W.Range("A1:A2"), CopyToRange:=Range("A1"), _ Unique:=False Cells.Select Cells.EntireColumn.AutoFit Range("A1").Select If Range("B3") <> "" Then 'Subtotais Range("A1").Select Selection.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(8, 9, 10) _ , Replace:=True, PageBreaks:=False, SummaryBelowData:=True ActiveSheet.Outline.ShowLevels RowLevels:=2 Range("A1").Select Else End If 'Ajuste do Cabeçario ActiveWindow.SmallScroll ToRight:=-1 Range("A1:K1").Select Selection.Borders(xlDiagonalDown).LineStyle = xlNone Selection.Borders(xlDiagonalUp).LineStyle = xlNone With Selection.Borders(xlEdgeLeft) .LineStyle = xlDouble .ColorIndex = xlAutomatic .TintAndShade = 0 .Weight = xlThick End With With Selection.Borders(xlEdgeTop) .LineStyle = xlDouble .ColorIndex = xlAutomatic .TintAndShade = 0 .Weight = xlThick End With With Selection.Borders(xlEdgeBottom) .LineStyle = xlDouble .ColorIndex = xlAutomatic .TintAndShade = 0 .Weight = xlThick End With With Selection.Borders(xlEdgeRight) .LineStyle = xlDouble .ColorIndex = xlAutomatic .TintAndShade = 0 .Weight = xlThick End With With Selection.Borders(xlInsideVertical) .LineStyle = xlContinuous .ColorIndex = xlAutomatic .TintAndShade = 0 .Weight = xlThin End With Selection.Borders(xlInsideHorizontal).LineStyle = xlNone With Selection.Font .Name = "Cambria" .Size = 12 .Strikethrough = False .Superscript = False .Subscript = False .OutlineFont = False .Shadow = False .Underline = xlUnderlineStyleNone .ColorIndex = xlAutomatic .TintAndShade = 0 .ThemeFont = xlThemeFontMajor End With With Selection.Font .Name = "Calibri" .Size = 11 .Strikethrough = False .Superscript = False .Subscript = False .OutlineFont = False .Shadow = False .Underline = xlUnderlineStyleNone .ColorIndex = xlAutomatic .TintAndShade = 0 .ThemeFont = xlThemeFontMinor End With Selection.Font.Bold = True Columns("F:F").ColumnWidth = 3.57 Columns("E:E").ColumnWidth = 3 Columns("G:G").ColumnWidth = 31.86 Columns("I:K").Select Columns("I:K").EntireColumn.AutoFit Columns("B:B").ColumnWidth = 37.14 ActiveWindow.SmallScroll ToRight:=-1 Columns("A:A").ColumnWidth = 3.71 Columns("A:A").ColumnWidth = 1 ' Columns("C:C").Select 'Selection.Font.Bold = False 'Selection.Font.Bold = True Columns("C:C").Select Selection.Font.Bold = False Selection.Font.Bold = True With Selection.Font .Color = -16776961 .TintAndShade = 0 End With Range("C1").Select With Selection.Font .ColorIndex = xlAutomatic .TintAndShade = 0 End With Range("A1:K1").Select W.Select ActiveCell.Offset(1, 0).Select pula_aba = ActiveCell.Value If ActiveCell.Value = "" Then Exit Do End If Set Y = Sheets(pula_aba) Y.Select Y.Range("A1").Select aba = ActiveSheet.Name Loop ActiveWorkbook.Save Erro: MsgBox (" Chegou ao último Centro de Custo... ( " & pula_aba & " ) - Se não erro no nome da Aba !!") MsgBox "Fim do Processo... Tenha um ótimo dia...." Application.DisplayAlerts = True Application.ScreenUpdating = True End Sub
  10. Ok, não foi bem claro na primeira mensagem do post, peço lhe perdão.... Como sou iniciante no VBA, e se houver outra necessidade de incluir planilha que não venha a ser salva separadamente, é só eu ir colocando o END NOT?
  11. Bom dia e obrigado pela resposta, só que não consegui rodar, no meu caso eu tenho umas 300 planilhas e as que não quero gravar separadamente são: Plan2 (C.Custo), Plan6 (Balancete), Plan7 (Plano de Contas) e Plan229 (Razão), estou definindo via SET as planilhas como A,B,C e D, para caso que haja alteração no nome não trave o processo. Como eu trataria esta situação. obrigado mais uma vez.
  12. Bom dia Galera, Consegui na internet um código para salvar as pastas (aba) de um arquivo que tem +- 30 pastas (aba), só que o código começa a gravar a partir da primeira pasta (aba), eu preciso saber se tem como começar a partir de uma pasta (aba) que eu selecione, exemplo: plan1, plan2, plan3, plan4, plan5......, preciso que comece a salvar a partir da plan3 em diante. código extraído do site https://www.tomasvasquez.com.br/blog/tag/excal Public Sub SplitSheetsToWorkbook() On Error GoTo TrataErro 'variáveis Dim newBook As Workbook Dim sheet As Worksheet Dim i As Byte 'Desativa os avisos e atualiação da tela Application.ScreenUpdating = False Application.DisplayAlerts = False For Each sheet In ThisWorkbook.Worksheets 'cria uma nova pasta de trabalho: Set newBook = Application.Workbooks.Add 'copia a planilha sheet.Copy Before:=newBook.Sheets(1) 'remove as outras For i = 2 To newBook.Worksheets.Count newBook.Worksheets(2).Delete Next i 'salva o arquivo newBook.SaveAs Replace(ThisWorkbook.FullName, ThisWorkbook.Name, vbNullString) & sheet.Name & ".xlsx" newBook.Close Next sheet TrataSaida: 'Reativa os avisos e atualiação da tela Application.ScreenUpdating = True Application.DisplayAlerts = True 'zera as variáveis Set newBook = Nothing Set sheet = Nothing MsgBox "Feito!" Exit Sub TrataErro: MsgBox Err.Description, vbCritical, "Erro" GoTo TrataSaida End Sub
  13. FSoares.FCS

    Filtro

    Bom dia Camarada..... Deu certo muito obrigado que Deus lhe abençoe..... Abraço.
  14. FSoares.FCS

    Filtro

    Bom dia Camarada, obrigado pela resposta mas no meu caso não dá para separar o filtro. A planilha original está no formato abaixo: Eu incluo 4 coluna no inicio e uso o filtro para separar o filial, centro de custo, conta e data, de forma que fique na mesma linha, exemplo abaixo: segue anexo a planilha a primeira é a original e a razão é como tem que ficar.Obrigado. 6_-_Ajuste_do_Razão_por_Centro_de_Custo_Analitico22_-_Cópia.zip

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

×