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.

Edson Luiz Branco

Membros Plenos
  • Total de itens

    588
  • Registro em

  • Última visita

  • Qualificações

    0%

Reputação

117

4 Seguidores

Informações gerais

  • Cidade e Estado
    Joinville/SC
  • Sexo
    Masculino
  1. @FSoares.FCS , boa noite. Faça um teste numa cópia de seu workbook: Sub CriarCCusto() Dim wsCC As Worksheet, ws As Worksheet, rg As Range, i As Integer Dim ListaCriadas As String With ThisWorkbook Set wsCC = .Worksheets("Centro de Custo") Set rg = wsCC.Range("C2", wsCC.Range("C1").End(xlDown)) For i = 1 To rg.Cells.Count On Error Resume Next Set ws = .Worksheets(rg.Cells(i).Value) If Err.Number = 9 Then If i = 1 Then .Worksheets.Add(After:=wsCC).Name = rg.Cells(i).Value ListaCriadas = rg.Cells(i).Value Else .Worksheets.Add(After:=.Worksheets(rg.Cells(i - 1).Value)).Name = rg.Cells(i).Value ListaCriadas = ListaCriadas & vbCrLf & rg.Cells(i).Value End If ElseIf Err.Number > 0 Then Exit Sub End If On Error GoTo 0 Next i End With If ListaCriadas <> vbNullString Then MsgBox "Criada(s) a(s) Planilha(s):" & vbCrLf & ListaCriadas, vbInformation, "LISTA DE CC CRIADOS" Set rg = Nothing: Set wsCC = Nothing: Set ws = Nothing End Sub
  2. Tente isso: Private Sub pesquisar_btn_Click() Const caminho = "\\ln008svr03\processos\Projeto BPF Bonsucesso\10_Recebimento\" Const arquivo = "RO.BN.05_002_Registro de Recebimento 2018.xlsb" Dim arqTemp As Object Dim EmpFound As Range Dim Wb As Workbook Application.ScreenUpdating = False With CreateObject("Scripting.FileSystemObject") If .FileExists(caminho & arquivo) Then .CopyFile Source:=caminho & arquivo, Destination:=caminho & arquivo & "(Cópia)", _ OverWriteFiles:=True Set arqTemp = .GetFile(caminho & arquivo & "(Cópia)") Else Exit Sub End If Set Wb = Workbooks.Open(arqTemp.Path) Wb.Sheets("Registro de Recebimento 2018").Activate '..... '..... '..... '..... Wb.Close SaveChanges:=False arqTemp.Delete True End With Set arqTemp = Nothing: Set EmpFound = Nothing: Set Wb = Nothing End Sub
  3. Bom dia, @diego_janjao Tô estranhando isso que tá acontecendo contigo. Quando você tem um ArquivoA em rede e o Usuário1 na Máquina1 já está com ele aberto e você, Usuário2 na Máquina2 abre-o via macro da maneira que você descreveu, com ReadOnly = True, o arquivo abre normalmente em modo Somente Leitura sem emitir nenhum aviso (testei aqui e rodou assim). Será que o ArquivoA já não estava aberto na sua Máquina2 ?
  4. @SAMUELLOPES , bom dia e vem vindo ao Clube do Hardware As funções ÍNDICE/CORRESP seriam mais apropriadas nessa situação. Mas vejamos o porquê do erro: A função PROCV só procura na primeira coluna do intervalo passado como argumento "matriz_tabela". Note no entanto que seu intervalo nomeado "ENTRADA" não começa na coluna que contém ID DO CONTENTOR (C) mas sim uma coluna antes (B). Então, pra usar PROCV você teria que ou redefinir ENTRADA para começar na coluna C ou, melhor, deslocar o intervalo com a função DESLOC uma coluna à direita: =SE(PROCV(B4;DESLOC(ENTRADA;0;1);1;FALSO);"P";"A") Incrementando para não aparecer erro #N/D quando não houver célula preenchida: =SEERRO(SE(PROCV(B4;DESLOC(ENTRADA;0;1);1;FALSO);"P";"A");"")
  5. @Flávia de Oliveira Batista , boa noite. Uma ideia seria: Sub FiltraMêsAtual() Dim Di As Variant, Df As Variant Di = DateSerial(Year(Date), Month(Date), 1): Df = DateAdd("m", 1, Di) - 1 Di = Format(Di, "mm/dd/yyyy"): Df = Format(Df, "mm/dd/yyyy") ActiveSheet.Range("$A$1:$H$1").AutoFilter Field:=8, Operator:=xlAnd, _ Criteria1:=">=" & Di, Criteria2:="<=" & Df End Sub
  6. @rafaelcamposbr , como você tem o 2016 dá pra usar a fórmulatexto junto com outras funções. basicamente sugiro: =somarproduto(1*(ext.texto(fórmulatexto(a1);lin(indireto("1:"&núm.caract(fórmulatexto(a1))));1)="+"))+1
  7. Qual a versão de seu Excel? Se for 2013 pra frente dá pra fazer através de fórmula (função FÓRMULATEXTO), senão faríamos por VBA.
  8. Boa noite, Uika. Seu arquivo estava num pendrive ou drive externo? É possível que ele tenha ficado corrompido. Faça uma cópia de segurança antes e então tente reparar o arquivo: Clique em Arquivo > Abrir e vá para o local em que a pasta de trabalho Excel está. Clique uma vez só no nome do arquivo para selecioná-lo e então clique na setinha ao lado do botão Abrir Escolha Abrir e Reparar Veja também algumas outras possibilidades em: O que é o Modo de Exibição Protegido
  9. Tens razão, @lHenrique_10 . É que dezembro começa com "de" também, então tem que colocar o espaço após o "de" na fórmula de substituição (a gafe foi minha, perdão ) Corrigindo, fica então: =DATA.VALOR(SUBSTITUIR(A1;"de ";""))
  10. Também dá pra usar a função DATA.VALOR substituindo primeiro a preposição "de" por caractere vazio (ela é que atrapalha a leitura direta). Exemplo, se em A1 está sua data, use: =DATA.VALOR(SUBSTITUIR(A1;"de";""))
  11. Ok, tente o seguinte então: Sub Gerador_Contagem_Click() Dim NúmLinhas As Long: NúmLinhas = Sheets("Cadastro").Range("C5").Value Dim rgCad As Range: Set rgCad = Sheets("Cadastro").Range("A10").Resize(NúmLinhas) Dim rgCtg As Range: Set rgCtg = Sheets("Contagem").Range("A9:A" & _ Sheets("Contagem").Range("A9").End(xlDown).Row) rgCtg.Resize(, 3).Clear rgCad.Copy rgCtg.Cells(1) rgCtg.Parent.Activate Set rgCad = Nothing: Set rgCtg = Nothing End Sub
  12. No último arquivo q você enviou, na planilha Cadastro não há nada na célula A8. Acho que você quis dizer A10 ou você está trabalhando com outra versão do arquivo em casa. Pergunta: na planilha Contagem, na hora de deletar os dados anteriores, é pra deletar só os da coluna A ou também os da B (Venda Bruta) e C (%Venda)?
  13. Boa noite, @Andersom Melari Veja se entendi seu propósito: Gerador de Contagem.zip
  14. @ViniciusNunesT bom dia... Então vamos lá: Sub Rearranjo() 'Define o intervalo de entrada como sendo toda área em volta de A1: Dim rg As Range: Set rg = Worksheets("ENTRADA").[A1].CurrentRegion 'Define início do intervalo de saída: Dim rgSaída As Range: Set rgSaída = Worksheets("SAIDA").Range("A1:E1") 'Define variáveis gerais: rg2 conterá o intervalo de vendas para cada revenda 'i e j servirão para percorrer cada lin/col de rg2 concatenando as strings do Cabeçalho 'com os valores de rg2. NúmLin1 e 2 servem para checar se todo intervalo foi percorrido, 'já que são de células mescladas: Dim rg2 As Range, i As Long, j As Long, NúmLin1 As Long, NúmLin2 As Long 'b é uma variável temporária que conterá a cada passada o valor de cada linha de rg2 'até elas terminarem. Cabeçalho tem o título que irá aparecer antes de todo valor para 'identificá-lo: Dim b, Cabeçalho Cabeçalho = Array("ID: ", "LOCAL: ", "REVENDA: ", "VENDEDOR: ", _ "VENDA " & Trim(rg.Cells(1, 5)) & ": ", "QUANTIDADE " & Trim(rg.Cells(1, 6)) & ": ", _ "VENDA " & Trim(rg.Cells(1, 7)) & ": ", "QUANTIDADE " & Trim(rg.Cells(1, 8)) & ": ", _ "VENDA TOTAL: ", "QUANTIDADE TOTAL: ", "EMAIL: ") 'Reduz rg de tabela inteira para trabalhar somente com a coluna das revendas, já que 'identifica cada agrupamento: Set rg = rg.Coumns(3) 'Verifica quantas linhas há para serem processadas: NúmLin1 = rg.Rows.Count 'Inicia o loop: Do 'Reduz rg para ir descendo toda a coluna C de célula em célula ou, se mesclada, 'o conjunto das mescladas: Set rg = rg.Cells(1).MergeArea 'Verifica: se de fato estão mescladas é porque é uma Revenda: If rg.MergeCells Then 'Pega todo o intervalo de 1 coluna à direita de cada Revenda e com tamanho de 7 'colunas,ou seja, dados das vendas de cada revenda de Vendedor até Total. 'Offset e/ou Resize correspondem à função DESLOC no Excel: Set rg2 = rg.Offset(0, 1).Resize(rg.Rows.Count, 7) 'Pra cada linha dos detalhes de venda de cada revenda: For i = 1 To rg2.Rows.Count 'Pra cada coluna entre Vendedor e Total Quantidade For j = 1 To 7 'Concatena todas as células das 7 colunas do intevalo. Também verifica se é 'a primeira linha, já que é diferente das demais. Também insere 10 espaços em 'branco entre uma informação e outra: b = b & IIf(rg2.Cells(i, j) <> "Total", Cabeçalho(j + 2), "") & rg2.Cells(i, j) & String(10, " ") Next j 'Insere um parágrafo ao final de cada linha b = b & vbCrLf Next i 'Desloca a primeira linha 50 espaços para que Total pareça alinhado com nome vendedor. 'Retira a marca de parágrafo e espaços a mais ao final do conjunto de linhas concatenadas: b = String(50, " ") & Trim(Left(b, Len(b) - 2)) 'Saída dos dados: Insere "ID: " e valor do ID na coluna A: rgSaída.Cells(1).Value = Cabeçalho(0) & rg.Cells(1).Offset(0, -2).Value 'Saída dos dados: Insere "Local: " e valor do Local na coluna B: rgSaída.Cells(2).Value = Cabeçalho(1) & rg.Cells(1).Offset(0, -1).Value 'Saída dos dados: Insere "Revenda: " e valor da Revenda na coluna C: rgSaída.Cells(3).Value = Cabeçalho(2) & rg.Cells(1).Offset(0, 0).Value 'Saída dos dados: Insere os valores concatenados (detalhes das vendas) na coluna D: rgSaída.Cells(4).Value = b 'Saída dos dados: Insere "E-mail: " e valor do Email na coluna E: rgSaída.Cells(5).Value = Cabeçalho(10) & rg.Cells(1).Offset(0, 8).Value 'Posiciona-se na próxima linha para receber a próxima remessa de dados: Set rgSaída = rgSaída.Offset(1, 0) 'Zera a variável para o próximo loop b = Null End If 'Acumula a quantidade de linhas já processadas com as da passada atual: NúmLin2 = NúmLin2 + rg.Rows.Count 'A vantagem do método Offset abaixo é que se houver linhas mescladas, ele avança 'não de uma em uma linha, mas para a próxima linha após o conjunto de linhas mescladas Set rg = rg.Cells(1).Offset(1) 'Testa se já processou todas as linhas: Loop Until NúmLin2 >= NúmLin1 'Ativa a planilha de Saída para exibir o resultado: rgSaída.Parent.Activate 'Esvazia as variáveis objeto Set rg = Nothing: Set rg2 = Nothing: Set rgSaída = Nothing 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

×