Eloize Teixeira

Boa tarde, pessoal ! Estou com um problema. Eu tenho uma conexão de dados de uma lista do Sharepoint pro Excel, onde a mesma é dinâmica, ou seja, novas linhas podem aparecer e/ou sumir. Essa Conexão chama-se "NPI" (vide anexo), e o intervalo vai da coluna A até AR, no entanto, utilizo as colunas paralelas para realizar anotações referente a cada linha.. AGORA o PROBLEMA: Quando uma linha some (porque já foi solucionada), o método QueryTable exclui a linha até a coluna AR (intervalo máximo da conexão), e as colunas paralelas ao invés de excluir junto (porque as anotações pertinentes não valem mais, se deslocam apenas, fazendo com que fique anotações da linha já excluída para uma nova existente. PERGUNTA: Como faço para que no comando VBA, atualize a conexão/intervalo da tabela de conexão exclua a linha inteira, e não só até o intervalo máximo de conexão ? Desde já, muito obrigada !

minha macro abaixo não faz uma das tarefas, que é ver os valores da aba Data - coluna AV, se existe na aba Week Update - coluna AK, e caso só exista da aba Data, então o respectivo valor na Coluna AT, mudar para "Historical" planilha aqui Sub DataUpdate() Dim Dary As Variant, Hary As Variant, Uary As Variant, Nary As Variant, Nhary As Variant Dim i As Long, c As Long, UsdRws As Long, nr As Long Dim Dic As Object Application.ScreenUpdating = False Worksheets("Data").Unprotect Password:="Henkel2020" Set Dic = CreateObject("scripting.dictionary") With Sheets("Week Update") UsdRws = .Range("C" & Rows.Count).End(xlUp).Row Uary = .Range("A3:AK" & UsdRws) End With With Sheets("Data") UsdRws = .Range("C" & Rows.Count).End(xlUp).Row Dary = .Range("AV3:AV" & UsdRws).Value2 Hary = .Range("AT3:AT" & UsdRws).Value2 End With For i = 1 To UBound(Dary) Dic(Dary(i, 1)) = i Next i With Sheets("Data") Dary = .Range("A3:AJ" & UsdRws).Value2 End With ReDim Nary(1 To UBound(Uary), 1 To 36) For i = 1 To UBound(Uary) If Dic.Exists(Uary(i, 37)) Then For c = 1 To 36 Dary(Dic(Uary(i, 37)), c) = Uary(i, c) Next c If Hary(Dic(Uary(i, 37)), 1) = "Historical" Then Hary(Dic(Uary(i, 37)), 1) = "" Else nr = nr + 1 For c = 1 To 36 Nary(nr, c) = Uary(i, c) Next c Hary(i, 1) = "Historical" ' what there are in "Data" but do not exists on "Week Update", the value is not changed to "Historical" End If Next i With Sheets("Data") .Range("A3:AJ" & UsdRws).Value = Dary .Range("AT3:AT" & UsdRws).Value = Hary If nr > 0 Then .Range("A" & UsdRws + 1).Resize(nr, 36).Value = Nary End If End With Sheets("Week Update").ListObjects(1).DataBodyRange.EntireRow.Delete Sheets("Week Update").Range("Update[Document NumberDocument Line Number]") = "=[@[Document Number]]&[@[Document Line Number]]" Worksheets("Data").Protect Password:="Henkel2020", DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFiltering:=True, UserInterfaceOnly:=True Worksheets("Data").EnableOutlining = True Application.ScreenUpdating = True End Sub

Boa noite, alguém sabe como consigo deixar mais intuitivo e rápido a macro abaixo ? linha = 3 Do While Sheets("Data").Cells(linha, "C") <> Empty Var3 = Application.Match(Sheets("Data").Cells(linha, "AV").Value, Sheets("Week Update").Columns(37), 0) If WorksheetFunction.IsError(Var3) Then 'caso 3: existe uma linha na planilha primária (Data) que foi deletada da semana atual(Week Update) linha_apagada = linha Sheets("Data").Cells(linha, "AT") = "Historical" End If linha = linha + 1 Loop o resto do código está como abaixo, mas parte dele não funciona como preciso (onde está com o comentário), e não estou conseguindo consertar, mas seria basicamente o código acima, só que chique como abaixo, e inserido no esquema abaixo: basicamente a parte que falta, é : se tem na aba data, checando a coluna AV com a aba Week Update com a coluna AK, e não existe na Week Update, então a linha checada na aba Data coluna AT fica como "Historical" Sub DataUpdate() Dim Dary As Variant, Hary As Variant, Uary As Variant, Nary As Variant, Nhary As Variant Dim i As Long, c As Long, UsdRws As Long, nr As Long Dim Dic As Object Application.ScreenUpdating = False Worksheets("Data").Unprotect Password:="Henkel2020" Set Dic = CreateObject("scripting.dictionary") With Sheets("Week Update") UsdRws = .Range("C" & Rows.Count).End(xlUp).Row Uary = .Range("A3:AK" & UsdRws) End With With Sheets("Data") UsdRws = .Range("C" & Rows.Count).End(xlUp).Row Dary = .Range("AV3:AV" & UsdRws).Value2 Hary = .Range("AT3:AT" & UsdRws).Value2 End With For i = 1 To UBound(Dary) Dic(Dary(i, 1)) = i Next i With Sheets("Data") Dary = .Range("A3:AJ" & UsdRws).Value2 End With ReDim Nary(1 To UBound(Uary), 1 To 36) For i = 1 To UBound(Uary) If Dic.Exists(Uary(i, 37)) Then For c = 1 To 36 Dary(Dic(Uary(i, 37)), c) = Uary(i, c) Next c If Hary(Dic(Uary(i, 37)), 1) = "Historical" Then Hary(Dic(Uary(i, 37)), 1) = "" Else nr = nr + 1 For c = 1 To 36 Nary(nr, c) = Uary(i, c) Next c Hary(i, 1) = "Historical" 'eu acho que essa parte não ta funcionando, que seria, se não achar o valor da coluna [Data] AV em [Week Update] AK, então [Data] AT, fica com o valor "Historical" End If Next i With Sheets("Data") .Range("A3:AJ" & UsdRws).Value = Dary .Range("AT3:AT" & UsdRws).Value = Hary If nr > 0 Then .Range("A" & UsdRws + 1).Resize(nr, 36).Value = Nary .Range("AT" & UsdRws + 1).Resize(nr, 1).Value = Nhary End If End With Sheets("Week Update").ListObjects(1).DataBodyRange.EntireRow.Delete Sheets("Week Update").Range("Update[Document NumberDocument Line Number]") = "=[@[Document Number]]&[@[Document Line Number]]" Worksheets("Data").Protect Password:="Henkel2020", DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFiltering:=True, UserInterfaceOnly:=True Worksheets("Data").EnableOutlining = True Application.ScreenUpdating = True End Sub após rodar a macro, se tiver certo os seguintes valores da coluna AV, ficarão como "Historical", na coluna AT; 40811073610 40820554010 40823667510 arquivo aqui

Olá especialistas, Eu tenho uma planilha chamada "Dados" e, lá da linha 4 e ao longo, tenho vários pontos com dados, como "Responsável principal" em AO, "País" em AK e "SBU" em AL; Também tenho outra planilha chamada "AuthUsers", onde criei a matriz abaixo; então, estou procurando um código VBA, que toda vez que uma pessoa abre o arquivo, filtra automaticamente essas colunas de acordo com a matriz abaixo; 1 - Na coluna "País", filtre duas opções se a matriz tiver vírgula; 2 - se estiver em branco, sem filtro; 3- se o nome não estiver nas colunas "Usuário", não é necessário filtro; Eu geralmente uso Application.UserName para ter esse recurso, mas não sei se outra maneira poderia ser melhor; você poderia me ajudar nisso?

Olá Mundo. Eu escrevi um código VBA para encontrar um valor em uma planilha e, se corresponder, basta copiar a linha inteira. OK, não é só isso, deixe-me explicar como funciona e o problema que estou enfrentando: Primeira folha, chamada "DATA"; Segunda folha, chamada "UPDATE DA SEMANA" 1 - A pessoa cola os dados pré-selecionados na planilha "WEEK UPDATE" e depois pressiona o botão para verificar se o valor existente na planilha existe na planilha "DATA"; SE SIM, a linha de A a AJ ("atualização semanal") é substituída na planilha "dados" nos mesmos colunares Caso contrário, a linha de A a AJ ("atualização semanal") é COLOCADA na planilha "dados" nos mesmos colunares 2 - O sistema verifica se os dados da planilha "data" não existem na planilha "atualização semanal", portanto, coloque um valor no colo AN como "Histórico" Se o collunm já estiver como "Histórico" e o sistema encontrar o valor de "Dados" em "atualização semanal", o valor "histórico" será sobrescrito como ""; .. AGORA MEU PROBLEMA ... Funciona muito bem, mas com uma pequena quantidade de linhas .. Estou usando linhas de 50K em "atualização semanal" e ~ 40K em "dados" e a macro não funciona alguma ajuda, POR FAVOR? ANEXO AQUI https://drive.google.com/file/d/1hwIvOUmTBBJdR5Ps1peWWOdVqvVosr1s/view?usp=sharing siga o código: Sub Preencher_dados() Application.ScreenUpdating = False Worksheets("Data").Unprotect Password:="Henkel2020" Worksheets("Week Update").Unprotect Password:="Henkel2020" Sheets("Data").Columns("AP").EntireColumn.Hidden = False Sheets("Week Update").Columns("AK").EntireColumn.Hidden = False linha = 3 contagem = 0 ultima_linha1 = Sheets("Data").Range("C80000").End(xlUp).Row ultima_linha2 = Sheets("Week Update").Range("C80000").End(xlUp).Row If ultima_linha2 <= 2 Then MsgBox "Não existem novos dados a serem transferidos.", vbExclamation: GoTo Final 'i = 3 'concatena coluna H e I da planilha Data 'Do While i <= ultima_linha1 ' Sheets("Data").Cells(i, "AP") = CStr(Sheets("Data").Cells(i, "H") & Sheets("Data").Cells(i, "I")) ' i = i + 1 'Loop 'i = 3 'concatena coluna H e I da planilha Week Update 'Do While i <= ultima_linha2 ' Sheets("Week Update").Cells(i, "AK") = CStr(Sheets("Week Update").Cells(i, "H") & Sheets("Week Update").Cells(i, "I")) ' i = i + 1 'Loop 'verificar adição de novas linhas (Secundária busca na primária) linha = 3 texto = "Existem materiais que necessitam de revisão na(s) linha(s): " Do While Sheets("Data").Cells(linha, "C") <> Empty Var3 = Application.Match(Sheets("Data").Cells(linha, "AP").Value, Sheets("Week Update").Columns(37), 0) If WorksheetFunction.IsError(Var3) Then 'caso 3: existe uma linha na planilha primária que foi deletada da semana atual linha_apagada = linha Sheets("Data").Cells(linha, "AN") = "Historic" End If If Not WorksheetFunction.IsError(Var3) And Sheets("Data").Cells(linha, "AN") = "Historic" Then 'caso 3: existe uma linha antes deletada que voltou semana atual contagem = 1 texto = texto & vbCr & linha & ";" Sheets("Data").Cells(linha, "AN") = Empty End If linha = linha + 1 Loop Do While Sheets("Week Update").Cells(linha, "C") <> Empty Var1 = Application.Match(Sheets("Week Update").Cells(linha, "AK").Value, Sheets("Data").Columns(42), 0) If WorksheetFunction.IsError(Var1) Then 'caso 1: existe uma nova linha na semana atual Sheets("Week Update").Cells(linha, 1).Resize(1, 36).Copy Destination:=Sheets("Data").Range("A80000").End(xlUp).Offset(1, 0) End If If Not WorksheetFunction.IsError(Var1) Then 'caso 2: não existe uma nova linha na semana atual -> subscrever linha_sub = Sheets("Data").Columns(42).Find(Sheets("Week Update").Cells(linha, "AK"), LookIn:=xlValues).Row Sheets("Week Update").Cells(linha, 1).Resize(1, 36).Copy Destination:=Sheets("Data").Cells(linha_sub, 1) End If linha = linha + 1 Loop 'verificar exclusão de linhas (primária busca na secundária) 'i = 3 'concatena coluna H e I da planilha Data 'ultima_linha1 = Sheets("Data").Range("A1048576").End(xlUp).Row 'Do While i <= ultima_linha1 ' Sheets("Data").Cells(i, "AP") = CStr(Sheets("Data").Cells(i, "H") & Sheets("Data").Cells(i, "I")) ' i = i + 1 'Loop Application.ScreenUpdating = True If contagem = 1 Then MsgBox texto, vbExclamation Final: Sheets("Week Update").Rows("4:80000").Delete Shift:=xlUp Sheets("Week Update").Range("A3:AJ3").ClearContents Sheets("Data").Columns("AP").EntireColumn.Hidden = True Sheets("Week Update").Columns("AK").EntireColumn.Hidden = True Sheets("Data").Select Worksheets("Data").Protect Password:="Henkel2020", DrawingObjects:=True, Contents:=True, Scenarios:=True _ , AllowFiltering:=True Worksheets("Week Update").Protect Password:="Henkel2020" Application.ScreenUpdating = True End Sub

Boa tarde pessoal, Sou iniciantes e as vezes me deparo com algumas não funcionalidades que não sei consertar, como abaixo: Tenho dois OptionButton e uma combobox, a principio o intuito é liberar a combobox somente se determinada optionbutton for selecionada. Optionbutton11 = True -> Combobox5 fica liberada Optionbutton12 = True -> Combobox5 nao fica liberada Optionbutton11 & Optionbutton12 = False -> Combobox5 nao fica liberada Poderiam me ajudar? Private Sub ComboBox5_Change() If OptionButton11 = True And OptionButton12 = False Then ComboBox5.Locked = False ComboBox5.Enabled = False ElseIf OptionButton11 = False And OptionButton12 = True Then ComboBox5.Locked = True ComboBox5.Enabled = True ElseIf OptionButton11 = False And OptionButton12 = False Then ComboBox5.Locked = True ComboBox5.Enabled = True End If End Sub

@Basole No privado.

@Basole Ta demorando muito, e são aproximadamente 1500 linhas. Ainda está rodando, então não sei o resultado ao certo, posso lhe enviar a planilha?

Gente, boa tarde! Faz muito tempo que não mexo com VBA e estou meio que com pressa, gostaria de saber se vocês podem ajudar. Tenho uma planilha com duas abas. Plan 1 = Preencher os dados correspondentes Plan2 = Onde estão todos os dados Plan 1 A B C D E 1 2 3 Plan 2 A B C D E 1 abacaxi ww ww ww 2 mamao ww ww ww 3 xuxu ww ww ww 4 joelho 5 computador Ao apertar um botao da Plan 2, a Plan 1 se prencha com os dados correspondentes: Plan1 A B C D E 1 abacaxi ww ww ww 2 mamao ww ww ww 3 xuxu ww ww ww Poderiam me ajudar?

@Basole Como faz isso?

@Basole eu tinha feito isso antes mas não tinha funcionado.... mas deu certo.

Boa tarde, Surgiu a necessidade de adicionar mais do que um anexo em minha macro para envio automático de e-mails no Excel, no entanto, procurei na internet e vi alguns fóruns dizendo para separar com ";", mas mesmo assim está dando erro. Será que poderiam me ajudar?: Sub EmitirRelatorio() Dim nome As String, HTMLBody As String Dim OA As Object, OM As Object Dim lMax As Long Dim lLinhaAtual As Long nome = Environ("USERPROFILE") & "\AppData\Local\Temp\" & Range("c1").Value & ".pdf";"G:\BRITA-CD_Itapevi\KPI Logistica\Expedição Pallets - Controle\Template\Padrão Minimo de Qualidade - Pallets Devolução.pdf" With OM .To = Sheets("Emitir Relatório").Range("E53").Value .CC = Sheets("Emitir Relatório").Range("E54").Value .Subject = "Relatório Pallets - " & "Período Acumulado Até: " & Sheets("Relat. Template").Range("D9") .HTMLBody = HTMLBody & "<br>" .Attachments.Add nome .Send End With Erro: (em anexo) _____________ Não está dando certo dessa forma. Arquivo 1: Environ("USERPROFILE") & "\AppData\Local\Temp\" & Range("c1").Value & ".pdf" Arquivo 2: "G:\BRITA-CD_Itapevi\KPI Logistica\Expedição Pallets - Controle\Template\Padrão Minimo de Qualidade - Pallets Devolução.pdf" É isso, se puderem me ajudar, agradecerei. Att, Elo

@osvaldomp Da onde você veio Osvaldo? Rs Você chega com umas soluções de outro mundo. Deu certo. adicionado 2 minutos depois @DJunqueira Muito obrigada pela sua disposição em me ajudar. Visualizei e realmente pareceu correto, mas ela funcionaria para mais de 3000 linhas ?! De qualquer forma obrigada! Arrasou.

@DJunqueira Muito obrigada. Desde já agradeço à atenção.

@DJunqueira 2013 Me ajuda? Preciso muito muito.