Midori

O telefone fixo será sempre o segundo conjunto de números? Quando esse filtro deve ser aplicado? Parece que você quer digitar o nome numa célula para retornar o número em outra. Essa busca pode ser feita com PROCV. E para separar os números, se for o Excel 365, tem a função DIVIDIRTEXTO onde você pode passar a barra como delimitador.

No menu Insert tem o Dropdown. Adicione na célula com a configuração Dropdown from range e selecione a lista de pedidos. Na coluna valor aplique vlookup/procv com o retorno da coluna D da aba Dados.

A função Hoje é uma das que não precisam receber nenhum valor/argumento. Como você já sabe basta entrar com =HOJE() na célula e o retorno um número de série da data atual. No caso das outras funções que serão necessárias aí, temos que passar alguns valores para elas. É o caso de Mod que espera dois conforme a sintaxe, MOD(número, divisor) Veja que essa tem dois parâmetros: Número (dividendo) e divisor. Portanto temos que passar dois argumentos. Mod retorna o resto de uma divisão entre números inteiros, então se p.ex você passar o número 4 e o divisor 2, =MOD(4;2), o retorno será 0 (zero) já este é resto de 4/2; Se for =MOD(5;2) o retorno será 1; E =MOD(6;2) o retorno é 0 (zero). Observe como vai alternando entre 0 e 1, esse é o mecanismo que podemos usar já que o primeiro argumento que passaremos é só uma sequencia que vai de 1 (janeiro) até 12 (dezembro). E para passar esses números para basta chamar a função Mês. Esta é a sintaxe, MÊS(núm_série) Pegando algumas datas de exemplo teremos, =MOD(MÊS("17/05/2024");2) =MOD(MÊS("18/05/2024");2) ... =MOD(MÊS("01/06/2024");2) As duas primeiras retornam 1 (resto de 5/2) e a última 0 (resto de 6/2). E para o seu caso é passar a função Hoje para o Mês no lugar dessas datas do exemplo. Aplique isso na função Se para retornar a informação Sim ou Não, sintaxe, SE(teste lógico, valor se verdadeiro, valor se falso)

Pegue o mês e faça o teste de par ou impar com a função Mod. Aí é só escolher qual será sim ou não.

Não precisa. Basta passar a variável com Split como já fez. É isso que a macro espera, o caminho do(s) arquivo(s) na coluna O. Só os nomes, sem colchetes, separados por ponto e vírgula.

O que não conseguiu? Só faltou a declaração de Nome, mas assim já roda sem erro. Assim vai pegar os arquivos informados na coluna O.

Aí não tem o código com as correções necessárias que comentei no último post.

O tipo do parâmetro Arquivos deve ser Variant como comentei. Aí está String. E falta declarar a variável Nome como Variant no procedimento Envia_Emails.

Como ficou o código completo e em qual linha acontece o erro?

@afcdfilho Para o seu código o compilador mostra vários alertas que você devia tentar entender o que significa cada um. Só para citar dois, Sobre gets: main.c:17:9: warning: ‘gets’ is deprecated [-Wdeprecated-declarations] Essa função é obsoleta e deve ser evitada por questões de segurança já que não oferece limite para a entrada dados. Prefira fgets. Nesta linha você acabou passando o endereço do peso, porém printf espera um valor. Então é só remover o operador &. main.c:19:18: warning: format ‘%f’ expects argument of type ‘double’, but argument 2 has type ‘float *’ [-Wformat=] 19 | printf("%f",&dados[i] .peso);

Para multiplos anexos é só chamar Add de Attachment para cada um em loop. O parâmetro Arquivos do seu procedimento Envia_Emails pode ser do tipo Variant para receber o vetor com a lista de anexos. Aí o loop fica assim, ... .Body = Mensagem For Each Nome In Arquivos .Attachments.Add Nome Next Nome .Display ' para envia o email diretamente defina o código .Send ... A variável Nome também é do tipo Variant. E a chamada, Envia_Emails EnviarPara, Mensagem, Split(Arquivos,";")

No seu loop a partir de ActiveCell a coluna G fica 3 colunas a direita. Então é só preencher lá quando acontecer o envio e fazer uma condição para enviar apenas quando não tiver nada na célua, p.ex, If ActiveCell.Offset(0, 3).Value <> "ENVIADO" Then ... ActiveCell.Offset(0, 3).Value = "ENVIADO" End If

Com fórmula no Excel 365 consegui chegar no mesmo resultado. A função chave para isso é a TOCOL (ou TOROW) que é capaz de pegar um arranjo/matriz NxM e transformar em Nx1 (ou vetor). E para facilitar ainda mais tem o recurso para remover dados em branco e configurar a organização deles. A função já deixa os dados na ordem correta, Aí é só indexar para formar a outra matriz,

Sem a função Unique pode ser feito com AddItem mesmo. Para adicionar os elementos no list, fiz o procedimento AdicionaItem com um teste para não pegar item repetido, veja se assim resolve, Option Explicit Private TabelaExtrato As ListObject Private Sub UserForm_Initialize() Set TabelaExtrato = ThisWorkbook.Worksheets("Extrato").[tb_Extrato].ListObject If Not TabelaExtrato.DataBodyRange Is Nothing Then listLancamentos.ColumnWidths = "0;0;60;0;0;0;0;0;0;80;100" listLancamentos.ColumnCount = TabelaExtrato.DataBodyRange.Columns.Count listLancamentos.List() = TabelaExtrato.DataBodyRange.Value Call AdicionaItem(listSituacao, TabelaExtrato, "Situação") Call AdicionaItem(listCategoria, TabelaExtrato, "Categoria") Call AdicionaItem(listSubcategoria, TabelaExtrato, "SubCategoria") End If End Sub Private Sub listLancamentos_Click() If listLancamentos.ListIndex >= 0 Then Dim Id As Integer Id = listLancamentos.List(listLancamentos.ListIndex, 0) txtData.Value = BuscaRegistro(TabelaExtrato, Id, "Data") txtId.Value = BuscaRegistro(TabelaExtrato, Id, "Id") txtValor.Value = BuscaRegistro(TabelaExtrato, Id, "Valor") txtVencimento.Value = BuscaRegistro(TabelaExtrato, Id, "Vencimento") End If End Sub Function BuscaRegistro(Tabela As ListObject, Id As Integer, NomeColuna As String) As String Dim intColuna As Integer Dim intId As Integer Dim Linha As Long intColuna = Tabela.ListColumns(NomeColuna).Index intId = Tabela.ListColumns("Id").Index If Not Tabela.DataBodyRange Is Nothing Then If WorksheetFunction.CountIf(Tabela.DataBodyRange.Columns(intId), Id) > 0 Then Linha = WorksheetFunction.Match(Id, Tabela.DataBodyRange.Columns(intId), 0) BuscaRegistro = Tabela.DataBodyRange(Linha, intColuna).Value End If End If End Function Sub AdicionaItem(Controle As Object, Tabela As ListObject, NomeColuna As String) If Not Tabela.DataBodyRange Is Nothing Then Dim intColuna As Integer Dim Linha As Long intColuna = Tabela.ListColumns(NomeColuna).Index For Linha = 1 To Tabela.DataBodyRange.Rows.Count If WorksheetFunction.CountIf( _ Tabela.DataBodyRange(1, intColuna).Resize(Linha), _ Tabela.DataBodyRange(Linha, intColuna)) < 2 Then Call Controle.AddItem(Tabela.DataBodyRange(Linha, intColuna).Value) End If Next Linha End If End Sub

Você pode consolidar tudo no menu Dados > Obter dados externos de um diretório. Então é só deixar todas lá que a atualização será automática na planilha consolidada.

Onde acontece o erro nas atribuições do List, se o seu excel for o 365, poderá usar a função RegistrosColuna do meu exemplo abaixo. Ou então faça com AddItem como antes. Para não apagar o List você pode remover a chamada de Clear do procedimento. *** Modifiquei a função BuscaRegistro com o acréscimo do parâmetro da tabela, fiz isso porque usei a referência a esse objeto em outras partes do código. Apliquei os registros nos ListBox com List no lugar de AddItem, veja que assim não precisa de loop para carregar os elementos. O nome dos controles: cbxTipo, lbxLancamentos, lbxSituacao, txtDescricao, txtValor e txtSituacao. Option Explicit Private TabelaExtrato As ListObject Private Sub UserForm_Initialize() Set TabelaExtrato = ThisWorkbook.Worksheets("Extrato").[tb_Extrato].ListObject If Not TabelaExtrato.DataBodyRange Is Nothing Then lbxLancamentos.ColumnWidths = "0;0;60;0;0;0;0;0;0;80;100" lbxLancamentos.ColumnCount = TabelaExtrato.DataBodyRange.Columns.Count lbxLancamentos.List() = RegistrosColuna(TabelaExtrato) lbxSituacao.List() = RegistrosColuna(TabelaExtrato, "Situação") cbxTipo.List() = RegistrosColuna(TabelaExtrato, "Tipo") End If End Sub Private Sub lbxLancamentos_Click() If lbxLancamentos.ListIndex >= 0 Then Dim Id As Integer Id = lbxLancamentos.List(lbxLancamentos.ListIndex, 0) txtDescricao.Value = BuscaRegistro(TabelaExtrato, Id, "Descrição") txtSituacao.Value = BuscaRegistro(TabelaExtrato, Id, "Situação") txtValor.Value = BuscaRegistro(TabelaExtrato, Id, "Valor") End If End Sub Function RegistrosColuna(Tabela As ListObject, Optional ByVal NomeColuna As String) As Variant If Not Tabela.DataBodyRange Is Nothing Then If NomeColuna <> "" Then Dim intColuna As Integer intColuna = Tabela.ListColumns(NomeColuna).Index RegistrosColuna = _ WorksheetFunction.Sort( _ WorksheetFunction.Unique(Tabela.DataBodyRange.Columns(intColuna))) Else RegistrosColuna = Tabela.DataBodyRange End If End If End Function Function BuscaRegistro(Tabela As ListObject, ByVal Id As Integer, ByVal NomeColuna As String) As String Dim intColuna As Integer Dim intId As Integer Dim Linha As Long intColuna = Tabela.ListColumns(NomeColuna).Index intId = Tabela.ListColumns("Id").Index If Not Tabela.DataBodyRange Is Nothing Then If WorksheetFunction.CountIf(Tabela.DataBodyRange.Columns(intId), Id) > 0 Then Linha = WorksheetFunction.Match(Id, Tabela.DataBodyRange.Columns(intId), 0) BuscaRegistro = Tabela.DataBodyRange(Linha, intColuna).Value End If End If End Function

Está tentando carregar o ListBox com a propriedade Value em vez de AddItem. A atribuição simples que comentei serve para o TextBox. Para o list você pode chamar também em loop, p.ex: Call ListBox.AddItem(BuscaRegistro(Id, "Subcategoria")). Se anexar o arquivo com as modificações será mais fácil ajudar.

O código completo, Sub PreencheQuadro() Dim Area As Range Dim Quadro As Range Dim Lin As Long Dim L As Long Dim C As Integer Dim Col As Integer Set Area = [D11:AL17] Set Quadro = [BC10:BK17] L = Quadro.Rows.Count C = Quadro.Columns.Count For Col = 1 To Area.Columns.Count For Lin = 1 To Area.Rows.Count If Area(Lin, Col).Value <> "" Then Quadro(L, C).Value = Area(Lin, Col).Value C = C - 1 If C Mod Quadro.Columns(1).Column = 0 Then L = L - 1 C = Quadro.Columns.Count End If End If Next Lin Next Col End Sub

O método que usou para retornar o valor da linha na função ProcuraIndiceRegistroPodId pode ser um problema no seu projeto. Se por algum motivo quiser inserir uma linha antes da tabela, terá que mudar o valor de indiceMinimo no código para retornar o valor correto. Além disso essa variável global pode ser pouco clara na manutenção do código já que esse valor 11 faz sentido para quem sabe o contexto dele. Em vez disso, se aplicar a função Find será bem mais seguro já que assim vai retornar o valor correto da linha independente de qualquer inserção e também será mais rápido já que não será necessário usar loop. Porém acho melhor usar um método mais simples para já retornar o registro. Isso pode ser feito passando para uma função o nome da coluna e o id para realizar a busca na tabela, p.ex, Function BuscaRegistro(ByVal Id As Integer, ByVal NomeColuna As String) As String Dim Tabela As ListObject Dim intColuna As Integer Dim intId As Integer Dim Linha As Long Set Tabela = ThisWorkbook.Worksheets("Extrato").[tb_Extrato].ListObject intColuna = Tabela.ListColumns(NomeColuna).Index intId = Tabela.ListColumns("Id").Index If Not Tabela.DataBodyRange Is Nothing Then If WorksheetFunction.CountIf(Tabela.DataBodyRange.Columns(intId), Id) > 0 Then Linha = WorksheetFunction.Match(Id, Tabela.DataBodyRange.Columns(intId), 0) BuscaRegistro = Tabela.DataBodyRange(Linha, intColuna).Value End If End If End Function Assim é só passar os argumentos para a função e fazer as atribuições, p.ex, Private Sub listLancamentos_Click() If listLancamentos.ListIndex > 0 Then Dim Id As Long Id = listLancamentos.List(listLancamentos.ListIndex, 0) txtData.Value = BuscaRegistro(Id, "Data") txtVencimento = BuscaRegistro(Id, "Vencimento") txtValor = BuscaRegistro(Id, "Valor") End If End Sub Isso acontece porque alguns controles chamam o procedimento Filtra_listLancamentos no Change (evento ativado ao carregar esses controles) e lá tem o Clear do ListBox.

Com macro acho que será mais fácil. Você pode fazer dois loops aninhados e controlar as variáveis das linhas e colunas. Para o quadro que recebe os valores, a variável da coluna será decrementado e da linha também quando chegar na coluna BC, p.ex: Quadro(L, C).Value = Valor(Linha).Value C = C - 1 If C Mod [BC:BC].Column = 0 Then L = L - 1 C = Quadro.Columns.Count End If

Para isso tem as funções de pesquisa. PROCV é uma das mais usadas. Aplique nas células B1 e C1. O primeiro argumento dela é A1 (valor que deseja buscar).

Para isso faça a seleção das células com a planilha ativa, p.ex: ThisWorkbook.Sheets("Teste").[A4:H30].Select

Chegou a testar o código sem esse "pequeno ajuste"? E funcionou?

Assim é para o VBA do Outlook. Para o Excel a atribuição é como está lá no link que comentei. *** Uma forma mais simples que fiz aqui foi atribuindo Item de MailEnvelope ao MailItem do Outlook (por isso a referência ao objeto deve estar selecionada), Sub MacroEmail() Dim Email As MailItem Dim Dialogo As FileDialog Dim Anexo As Variant Set Email = ThisWorkbook.Sheets("Teste").MailEnvelope.Item Set Dialogo = Application.FileDialog(msoFileDialogFilePicker) Dialogo.AllowMultiSelect = True If Dialogo.Show <> 0 Then For Each Anexo In Dialogo.SelectedItems Call Email.Attachments.Add(Anexo) Next Anexo End If Email.To = "" Email.Subject = "Teste" Email.Send End Sub Assim vai a planilha no corpo do email com o anexo selecionado no diálogo. Pode acontecer uma falha em MailEnvelope, para resolver isso é só salvar a planilha.

O código continua praticamente o mesmo, é como se não tivesse lido o que escrevi... Ainda está com MailEnvelope e CurrentItem. Veja se tem alguma dúvida sobre o que já foi dito.