Muca Costa

Sugestão em anexo: Excluído por erro na sugestão... log venda vinhedo_Muca.rar

Veja se ajuda: Sub macro_x() Dim Ul As String, i As Integer, Hj As String Hj = Format(Date, "dddd") Ul = Planilha1.Cells(Rows.Count, "B").End(xlUp).Row For i = 3 To Ul If Hj = "terça" Or Hj = "quinta" Or Hj = "sábado" Then Planilha1.Cells(i, 2) = "-x-" Planilha1.Cells(i, 3) = "-x-" Planilha1.Cells(i, 4) = "-x-" Planilha1.Cells(i, 5) = "-x-" Planilha1.Cells(i, 6) = "-x-" End If Next End Sub

guicrissantos, você não está percebendo que está concentrado tudo na sub Gravar? O evento, após gravar, chama os outras Sub's; tudo em um só botão... Inclusive pode retirar o "_Click" das Sub's

Essas linhas: OcultarLinhasBC_Click LimparDadosReativarLinhas_Click Tem que ter o mesmo nome das sub's que ocultam, limpam e reativam...

Private Sub Gravar() Dim Ul As String, i As Integer, x As Integer x = MsgBox("APÓS A GRAVAÇÃO, TODOS SEUS DADOS SERÃO APAGADOS. DESEJA REALMENTE APAGAR TODOS OS LANÇAMENTOS?" & Chr(13) & Chr(13) & "ATENÇÃO pois, não será possivel desfazer esta ação.", vbYesNo + vbQuestion, Title:="© Muca Sistemas - 2021") If x <> vbYes Then Exit Sub End If Ul = Planilha11.Cells(Rows.Count, "B").End(xlUp).Row For i = 2 To Ul If Planilha11.Cells(i, 2) = Planilha9.Cells(6, 2) Then Planilha11.Cells(i, 6) = Planilha9.Cells(4, 7) Planilha11.Cells(i, 18) = Planilha9.Cells(4, 5) Planilha11.Cells(i, 19) = Planilha9.Cells(4, 4) Planilha11.Cells(i, 20) = Planilha9.Cells(4, 13) End If Next OcultarLinhasBC_Click LimparDadosReativarLinhas_Click Range("B12").Select MsgBox "Dados Gravados com Sucesso!", vbInformation, "REGISTRANDO DADOS" End Sub

Primeiro: Sub Gravar() Dim Ul As String, i As Integer Ul = Planilha11.Cells(Rows.Count, "B").End(xlUp).Row 'Conta linhas preenchidas em B Aba BANCODEDADOS For i = 2 To Ul 'Busca, em BANCO DE DADOS, a data correspondente a B6 de OPERAÇÕES If Planilha11.Cells(i, 2) = Planilha9.Cells(6, 2) Then 'Se em linha (i) & coluna B de BANCODEDADOS for igual a B6 de OPERAÇÕES, grava os dados Planilha11.Cells(i, 6) = Planilha9.Cells(4, 7) 'linha (i) & coluna F de BANCODEDADOS igual a G4 de OPERAÇÕES Planilha11.Cells(i, 18) = Planilha9.Cells(4, 5) 'linha (i) & coluna R de BANCODEDADOS igual a E4 de OPERAÇÕES Planilha11.Cells(i, 19) = Planilha9.Cells(4, 4) 'linha (i) & coluna S de BANCODEDADOS igual a D4 de OPERAÇÕES Planilha11.Cells(i, 20) = Planilha9.Cells(4, 13) 'linha (i) & coluna T de BANCODEDADOS igual a M4 de OPERAÇÕES End If Next Range("B6").Select MsgBox "FIM" End Sub Segundo: Muito confuso, não entendi...

Tente assim: Click lado direito na aba OPERAÇÕES/Exibir Código, incluir o evento abaixo: Private Sub Worksheet_Change(ByVal Target As Excel.Range) If Target.Column = 7 Then ThisRow = Target.Row If Range("E" & ThisRow) = "" Then MsgBox "Informe o Operador" Range("E" & ThisRow).Select Exit Sub End If End If End Sub Em um Módulo: Sub Gravar() Dim Ul As String, i As Integer Ul = Planilha11.Cells(Rows.Count, "B").End(xlUp).Row For i = 2 To Ul If Planilha11.Cells(i, 2) = Planilha9.Cells(6, 2) Then Planilha11.Cells(i, 6) = Planilha9.Cells(4, 7) Planilha11.Cells(i, 18) = Planilha9.Cells(4, 5) Planilha11.Cells(i, 19) = Planilha9.Cells(4, 4) Planilha11.Cells(i, 20) = Planilha9.Cells(4, 13) End If Next Range("B6").Select MsgBox "FIM" End Sub

Veja se ajuda... MacrosXY.rar

Sugestão cfe. anexo... teste.xlsx

Em anexo: TESTE.rar

Veja o anexo... TESTE.rar

=procv(e3;a2:b12;2;0)*procv(e3;h2:i12;2;0)+procv(e3;a2:b12;2;0)

Veja se é isso (Anexo) planilha.rar

Anexe modelo da sua planilha para facilitar a ajuda.

Para facilitar a ajuda, anexe um exemplo de sua planilha, informando todas as possibilidades possíveis e o resultado esperado...

Inclua no Módulo1: Sub TextoParaMoeda() Dim LastRowA Dim LastRowB Dim rngCelula As Range LastRowA = Sheets("Filtros").Cells(Rows.Count, 24).End(xlUp).Row LastRowB = Sheets("Filtros").Cells(Rows.Count, 31).End(xlUp).Row Set rngCelula = Application.Union(Range("X3:X" & LastRowA), Range("AE3:AE" & LastRowB)) With rngCelula .NumberFormat = "$ #,##0.00" .FormulaLocal = rngCelula.Value End With End Sub Depois é só executar a macro, se desejar, pode incluir um botão...

Veja se ajuda: O filtro desejado é feito a partir de Form, clicando nos botões Filtrar A e Filtrar B a partir da coluna S. Pode ser feito por cliente, por produto, por classe e por princípio... FiltroAvançado007.rar

LeoSWK disse: "Colocando Filtros nas colunas: PRODUTO:CLASSE:PRINCIPIO ATIVO, assim posso comparar as vendas do cliente por produto ou a classe do produto, com isso vai facilitar minhas comparações em 100%." Me desculpe, mas não estou entendendo o que você quer. Vs precisa demonstrar, com exemplo, a sua necessidade...

Em anexo sugestão para filtrar até 10 clientes. FiltroAvançado-007.rar

Em anexo uma nova versão com algumas modificações... Obs.: Ao incluir novos registros torna-se necessário clicar no botão "Atualiza Listas" para atualizar as Listas suspensas. O filtro com múltiplos critérios pode ser feito, simultaneamente, informando nas colunas de A3 a F3 Quantos aos seus novos pleitos, acho que faltam maiores esclarecimentos. Contudo, já fizemos algum progresso com relação ao post inicial... FiltroAvançado-006.rar

Verdade LeoSWK, agora que testei a macro e, realmente, dá esse erro... Vou verificar... Enquanto isso espero que você tenha ajuda dos mestres do Fórum.

Para incluir as macros: Abra o editor VBA (Alt + F11) Copie/Cole as macros Para executar as macros: Exibir/Macros/RetiraEspaço Exibir/Macros/ListaCliente Pode ser também através de um botão...

A lista pode ser feita via macro, por exemplo para lista de clientes: Sub ListaCliente() Dim rCell As Range Dim rRange As Range Dim Lista As String Set rRange = Range("A5:A" & WorksheetFunction.CountA(Range("A:A"))) For Each rCell In rRange If WorksheetFunction.CountIf(Range("A5:A" & rCell.Row), rCell.Value) = 1 Then Lista = Lista & rCell.Value & "," End If Next rCell Range("A3").Select With Selection.Validation .Delete .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _ xlBetween, Formula1:=Lista .IgnoreBlank = True .InCellDropdown = True .InputTitle = "" .ErrorTitle = "" .InputMessage = "" .ErrorMessage = "" .ShowInput = True .ShowError = True End With End Sub Porém percebe-se que alguns registros possuem espaços extras, assim antes da sub anterior seria necessário ajustar: Sub RetiraEspaço() 'Excluirá espaços extras de AMBOS OS LADOS. Dim MyCell As Range On Error Resume Next Selection.Cells.SpecialCells(xlCellTypeConstants, 23).Select For Each MyCell In Selection.Cells MyCell.Value = Trim(MyCell.Value) Next On Error GoTo 0 End Sub

Veja a nova versão. O filtro é feito via lista na linha 3 ... FiltroAvançado-005.rar

Veja se o anexo lhe ajuda. No exemplo o filtro é feito com informações disponíveis em I2 a O2 FiltroAvançado-005.rar