Ir ao conteúdo
  • Comunicados

    • Gabriel Torres

      Seja um moderador do Clube do Hardware!   12-02-2016

      Prezados membros do Clube do Hardware, Está aberto o processo de seleção de novos moderadores para diversos setores ou áreas do Clube do Hardware. Os requisitos são:   Pelo menos 500 posts e um ano de cadastro; Boa frequência de participação; Ser respeitoso, cordial e educado com os demais membros; Ter bom nível de português; Ter razoável conhecimento da área em que pretende atuar; Saber trabalhar em equipe (com os moderadores, coordenadores e administradores).   Os interessados deverão enviar uma mensagem privada para o usuário @Equipe Clube do Hardware com o título "Candidato a moderador". A mensagem deverá conter respostas às perguntas abaixo:   Qual o seu nome completo? Qual sua data de nascimento? Qual sua formação/profissão? Já atuou como moderador em algo outro fórum, se sim, qual? De forma sucinta, explique o porquê de querer ser moderador do fórum e conte-nos um pouco sobre você.   OBS: Não se trata de função remunerada. Todos que fazem parte do staff são voluntários.

FSoares.FCS

Membros Plenos
  • Total de itens

    33
  • Registro em

  • Última visita

  • Qualificações

    N/D
  1. 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.
  2. 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.
  3. 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
  4. 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
  5. Muito obrigado, que Deus lhe abençoe me ajudou muito.....
  6. 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
  7. 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?
  8. 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.
  9. 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
  10. Filtro

    Bom dia Camarada..... Deu certo muito obrigado que Deus lhe abençoe..... Abraço.
  11. 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
  12. Filtro

    de qualquer forma vai ultrapassar as 24 linha de pesquisa e preciso que seja automático desta forma ficaria manual....mas obrigado.... pela dica.... abraço...
  13. Filtro

    segue a planilha, 6_-_Ajuste_do_Razão_por_Centro_de_Custo_Analitico.7z
  14. Filtro

    a planilha ultrapassar o tamanho exigido, se quiser passo no e-mail o meu é fsoares.fcs@gmail.com
  15. Filtro

    Boa tarde Galera, estou com um dilema tenho uma planilha que estou tentando elaborar uma função automática, como não manjo muito do VBA eu uso um pouco a função gravar macro, a planilha tem +- 32 mil linha e quando coloco o filtro para filtrar a palavra "Filial" o sistema para a gravação da macro e mostra o erro "Número excessivo de continuação de linhas", existe uma formula de fazer este filtro?; Se eu fizer normalmente sem usar a gravação o sistema executa normalmente. Desde já agradeço. segue a macro que estava fazendo e não consigo concluir: Cells.Select Selection.Copy Sheets("Razao").Select Range("A1").Select ActiveSheet.Paste Selection.ColumnWidth = 15 Columns("F:G").Select Range("G1").Activate Application.CutCopyMode = False Selection.Delete Shift:=xlToLeft Columns("E:E").ColumnWidth = 4.29 Columns("D:D").ColumnWidth = 64.29 Columns("D:D").ColumnWidth = 67.14 Rows("30558:30558").EntireRow.AutoFit Cells.Select Cells.EntireColumn.AutoFit Cells.EntireRow.AutoFit Range("A1").Select Cells.Replace What:=" ", Replacement:=" ", LookAt:=xlPart, SearchOrder _ :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False Cells.Replace What:=" ", Replacement:=" ", LookAt:=xlPart, SearchOrder _ :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False Cells.Replace What:=" ", Replacement:=" ", LookAt:=xlPart, SearchOrder _ :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False Cells.Replace What:=" ", Replacement:=" ", LookAt:=xlPart, SearchOrder _ :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False Cells.Replace What:=" ", Replacement:=" ", LookAt:=xlPart, SearchOrder _ :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False Cells.Replace What:=" ", Replacement:=" ", LookAt:=xlPart, SearchOrder _ :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False Cells.Replace What:=" ", Replacement:=" ", LookAt:=xlPart, SearchOrder _ :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False Cells.Select Cells.EntireColumn.AutoFit Range("B2").Select Columns("B:B").ColumnWidth = 2.71 Columns("C:C").ColumnWidth = 5 Columns("E:E").ColumnWidth = 2.86 Range("A3").Select Rows("3:3").EntireRow.AutoFit Columns("B:B").ColumnWidth = 42.57 Rows("3:3").EntireRow.AutoFit Columns("B:B").EntireColumn.AutoFit Columns("A:D").Select Selection.Insert Shift:=xlToRight Range("A1").Select ActiveCell.FormulaR1C1 = "FILIAL" Range("B1").Select ActiveCell.FormulaR1C1 = "CONTA" Range("C1").Select ActiveCell.FormulaR1C1 = "DATA" Range("D1").Select ActiveCell.FormulaR1C1 = "C.CUSTO" Cells.Select Cells.EntireColumn.AutoFit Range("A4").Select ActiveCell.FormulaR1C1 = "=RC[4]" Range("A5").Select ActiveCell.FormulaR1C1 = "=R[-1]C" Range("A5").Select Selection.Copy Range("A6").Select Range(Selection, Selection.End(xlDown)).Select ActiveSheet.Paste ActiveSheet.Paste Range("A1").Select Application.CutCopyMode = False Selection.AutoFilter Columns("A:A").Select ActiveSheet.Range("$A:$L").AutoFilter Field := 5, Criteria1 := Array( _ "Filial:0101 CONTA - 3.5.1.01.0101 COMPRAS DE IMOBILIZADOS EM GERAL", _ "Filial:0101 CONTA - 3.9.1.01.0101 ALIMENTACAO DE FUNCIONARIOS", _ "Filial:0101 CONTA - 3.9.1.01.0102 CESTAS BASICAS", _ "Filial:0101 CONTA - 3.9.1.01.0104 CONVENIO MEDICO", _ "Filial:0101 CONTA - 3.9.1.01.0106 SEGURO DE VIDA EM GRUPO", _ "Filial:0101 CONTA - 3.9.1.01.0109 MEDICINA OCUPACIONAL/ENGENHARIA DO TRABA", _ "Filial:0101 CONTA - 3.9.1.01.0112 TELEFONIA", _ "Filial:0101 CONTA - 3.9.1.01.0114 ENERGIA ELETRICA FABRIL", _ "Filial:0101 CONTA - 3.9.1.01.0117 ANALISES CLINICAS OCUPACIONAIS", _ "Filial:0101 CONTA - 3.9.1.01.0119 PEDAGIO SEM PARAR", _ "Filial:0101 CONTA - 3.9.1.01.0121 LOCACAO EQUIPAMENTO DE INFORMATICA", _ "Filial:0101 CONTA - 3.9.1.01.0127 ALIMENTACAO FUNCIONARIO- CARTAO", _ "Filial:0101 CONTA - 3.9.1.01.0129 CONVENIO NORTE DAME", _ "Filial:0101 CONTA - 3.9.1.01.0130 CONVENIO SULAMERICA SAUDE", _ "Filial:0101 CONTA - 4.1.2.01.0101 CONSUMO DE MATERIA-PRIMA", _ "Filial:0101 CONTA - 4.1.2.01.0103 CONSUMO DE MATL.AUXILIAR", _ "Filial:0101 CONTA - 4.1.2.01.0106 CONSUMO PRODUTO ACABADO", _ "Filial:0101 CONTA - 4.1.2.01.0201 SALARIOS", _ "Filial:0101 CONTA - 4.1.2.01.0202 FERIAS", _ "Filial:0101 CONTA - 4.1.2.01.0207 PREVIDENCIA SOCIAL", _ "Filial:0101 CONTA - 4.1.2.01.0208 FUNDO DE GARANTIA", _ "Filial:0101 CONTA - 4.1.2.01.0209 REFEICOES", _ "Filial:0101 CONTA - 4.1.2.01.0210 CESTA BASICA", _ End Sub

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

×