zav60
-
Total de itens
16 -
Registro em
-
Última visita
Posts postados por zav60
-
-
MinerO,
Não tem de que agradecer.
-
Caro MinerO,
Vá ao ao botão "Accionar", e com o botão direito do rato abra a opção Macro, faça o seu Edit (desculpe os termos irem em inglês pois não faço ideia de como são em português - Editar?) e quando abrir a janela do Visual Basic substitua o seu conteúdo - todo ele!!! - pelo seguinte programa:
Sub ProcTransf() 'Macro para apagar os dados nas outras sheets 'e depois copiar da Geral para as outras 'e ordenar os dados copiados Dim sht As Worksheet Dim Cll As Range Dim LProc As Integer Dim LCop As Integer On Error GoTo Err_Execute For Each sht In Worksheets sht.Activate If ActiveSheet.Name <> "Geral" Then With ActiveSheet Range("A2:J65536").Delete Shift:=xlToLeft Range("A1").Select End With End If Next sht Worksheets("Geral").Activate LProc = 2 LCop = 2 While Len(Range("A" & CStr(LProc)).Value) > 0 If Range("J" & CStr(LProc)).Value = "Arg" Then Rows(CStr(LProc) & ":" & CStr(LProc)).Copy _ Destination:=Worksheets("Argentina").Rows(CStr(LCop) & ":" & CStr(LCop)) LCop = LCop + 1 Sheets("Geral").Select ElseIf Range("J" & CStr(LProc)).Value = "Ven" Then Rows(CStr(LProc) & ":" & CStr(LProc)).Copy _ Destination:=Worksheets("Venezuela").Rows(CStr(LCop) & ":" & CStr(LCop)) LCop = LCop + 1 Sheets("Geral").Select End If LProc = LProc + 1 Wend Application.CutCopyMode = False For Each sht In Worksheets sht.Activate If ActiveSheet.Name <> "Geral" Then With ActiveSheet Columns("A:J").Select Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlYes Range("A1").Select End With End If Next sht Worksheets("Geral").Activate Range("A1").Select MsgBox "FEITO!" Exit Sub Err_Execute: MsgBox "Ocorreu um erro. Provavelmente não existe a planilha destino" End SubSe tiver dificuldades ou mais sugestões, diga
-
Caro MinerO,
Siga este link
http://rapidshare.com/files/173802170/Exp2.xls.html
E depois diga se lhe serve...
-
Olá andoliveira4
Experimente uma destas macros:
Sub Macro2() Dim PNm, ENm, FNm, WkB, WB Application.DisplayAlerts = False Worksheets("TESTE_ABRE_ARQUIVO").Activate PNm = Range("A1").Value ENm = Range("A2").Value FNm = Range("A3").Value WkB = PNm & ENm & FNm WB = ENm & FNm Workbooks.Open Filename:=WkB 'A seguir, aonde está XXXXXX coloque o nome da planilha que 'pretende activar (neste caso) no HBA_PROC9_1.xls - Talvez Sheet1? Worksheets("XXXXXX").Activate Range("A1").Select Selection.Copy ThisWorkbook.Worksheets("TESTE_ABRE_ARQUIVO").Activate Range("A20").Select Selection.PasteSpecial Paste:=xlValues, operation:=xlNone Application.CutCopyMode = False Workbooks(WB).Close Application.DisplayAlerts = True End Subou então:Sub Macro3() Dim PNm, ENm, FNm, WkB, WB Application.DisplayAlerts = False Worksheets("TESTE_ABRE_ARQUIVO").Activate PNm = Range("A1").Value ENm = Range("A2").Value FNm = Range("A3").Value WkB = PNm & ENm & FNm WB = ENm & FNm Workbooks.Open Filename:=WkB 'A seguir, aonde está XXXXXX coloque o nome da planilha que 'pretende activar (neste caso) no HBA_PROC9_1.xls - Talvez Sheet1? Workbooks(WB).Worksheets("XXXXXX").Range("A1").Copy _ Destination:=ThisWorkbook.Worksheets("TESTE_ABRE_ARQUIVO") _ .Range("A20") Application.CutCopyMode = False Workbooks(WB).Close Application.DisplayAlerts = True End SubA diferença entre as duas é que a primeira copia e passa só o valor, enquanto a segunda copia e passa tudo
Depois diga qualquer coisa...
-
Olá Maska
O que V. quer não faz muito sentido pois é carregar em duas teclas (Ctrl+outra qualquer) para evitar usar apenas uma (v)
Talvez se V. explicar melhor o contexto em que pretende que a coluna I tenha esses "v".s todos, haja uma maneira lógica de resolver o seu problema
-
-
Olá MetallicA_cps,
Você pretende copiar de que sheet (planilha?) para que sheet?
Será da Login_logout2 para a Plan1? Para a Plan2?
Para que precisa da Login_logout2?
-
Bom dia MetallicA_cps,
Experimente com este programa
Sub ProCopia() Dim ProcLinha As Integer Dim CopPaLinha As Integer Dim ProcNum As String On Error GoTo Err_Execute ProcNum = InputBox("Escolha o valor a procurar.", "Procure o número") ProcLinha = 4 'Começa a procurar na linha 4 CopPaLinha = 2 'Copia para a linha 2 da Sheet2 While Len(Range("A" & CStr(ProcLinha)).Value) > 0 'Enquanto a coluna A for maior que 0 If Range("G" & CStr(ProcLinha)).Value = ProcNum Then 'Se na coluna G encontrar copia Rows(CStr(ProcLinha) & ":" & CStr(ProcLinha)).Select Selection.Copy Sheets("Sheet2").Select 'e passa para a Sheet2 Rows(CStr(CopPaLinha) & ":" & CStr(CopPaLinha)).Select ActiveSheet.Paste CopPaLinha = CopPaLinha + 1 'Vai à linha seguinte Sheets("Sheet1").Select 'Seleciona a Sheet1 de novo End If ProcLinha = ProcLinha + 1 Wend Application.CutCopyMode = False Range("A3").Select MsgBox "FEITO." Exit Sub Err_Execute: MsgBox "Ocorreu um erro." End SubPS. Não se esqueca de utilizar uma cópia quando utiliza um programa que não sabe o que vai provocar...
-
Caro Candeias,
Lamento não poder ajudar mais do que o que tentei. Confesso que estou confuso.
O Excel que uso é o "original" (quero dizer, o dos EUA). Não conheço a versão portuguesa (para o mercado brasileiro, ou mesmo para o português). O que uso, de facto, tem o "." como referência para a unidade mas continuo a achar que o problema não vem daí porque a programação é feita no sentido de procurar algo, não se preocupando se é texto ou número, isto é, se se usa a "," ou o "." como separador de unidade. V. diz que se trocar a "," pelo "." a procura funciona em pleno, o que me deixou ainda mais confuso. Eu experimentei fazer o contrário (trocar os pontos por vírgulas) e a busca funcionou na mesma. Só não funciona nos casos em que se procura filtrar, por exemplo, 2.300 quando se pretendia 2.300,00. Mas isso também se passa se eu tiver 2,300.00 numa célula e quiser filtrar por 2,300 ou 2300.00.
Bom, se descobrir alguma coisa diga...
-
Caro Candeias,
1-Eu experimentei o que V. sugeriu no seu primeiro post e de facto - sabe-se lá porque razão - não registou qualquer acção na macro daí ter dito "De facto é estranha a situação que aponta...";
2-O meu Excel não é em português... mas não creio que venha daí o problema.
3-O código que lhe enviei, criei-o no meu local de trabalho. Hoje, domingo, estou em casa e voltei a testá-lo no Excel que tenho em casa e uma vez mais funcionou em pleno. Acho estranho não funcionar no seu. Dá-lhe alguma mensagem de erro? Pura e simplesmente não produz nenhuma acção? Tem a certeza que introduziu todo o código? Está a dar os dados correctamente (i.e. está a utilizar a coluna A)?
-
Caro Candeias,
De facto é estranha a situação que aponta...
Bom, mas a solução será esta:
Sub Exp() Dim X As String X = InputBox("Qual o número que pretende filtrar?") Selection.AutoFilter Field:=1, Criteria1:=X End SubExperimente e diga qualquer coisa...
-
Olá RogerioPontes,
Pelo que percebi do seu código V. tem um WORKBOOK chamado "BDComponente.XLS" no directório "I:\Oficina_Componentes\GESTAO\Componente\" e quando V. o abre ele dá-lhe o valor que está na última célula não vazia, apartir da célula A65536 através da seguinte linha de código
MsgBox "Relatorio atualizado em" & Range("A65536").End(xlUp).ValueO problema é que V. está a usar um evento ( Sub Workbook_Open() ) que funciona a nível do WORKBOOK "BDComponente.XLS" e portanto só funciona UMA vez e é quando V. o abre. Para V. perceber melhor experimente abrir um novo workbook, vá ao Editor do Visual Basic e no ThisWorkbook insira o seguinte códigoPrivate Sub Workbook_Open() Worksheets("Sheet2").Activate Worksheets("Sheet1").Activate End SubNas planilhas "Sheet1" e "Sheet2" insira em cada uma delas o seguinte códigoPrivate Sub Worksheet_Activate() MsgBox "A planilha " & ActiveSheet.Name & " foi actualizada em " & Range("A65536").End(xlUp).Value End Sube na coluna A de cada uma das planilhas escreva um número qualquer.
Feche gravando-o e reabra. Vai ver que ele lhe dá uma mensagem com esses números para cada uma das planilhas (a 1 e a 2).
-
Olá Gustavo
Na planilha "Teste" use o seguinte código
Private Sub Worksheet_Change(ByVal Target As Range) If Target <> Range("E1") Then Exit Sub On Error GoTo ErrHandler Application.EnableEvents = False If Target = Range("E1") Then If Target.Value > Range("E2") Then Call Exp1 End If ErrHandler: Application.EnableEvents = True End Sube num módulo novo, useSub Exp1() Dim Xs, ws As Worksheet Set Xs = Worksheets("Final") For Each ws In Worksheets If ws.Name <> Xs.Name Then 'MsgBox ws.Name ws.Visible = False End If Next ws End Sub Sub Exp2() Dim ws As Worksheet For Each ws In Worksheets ws.Visible = True Next ws End SubDepois, na "Final" crie uma "autoshape" aonde vai ligar o código Exp2
Se precisar de mais ajuda diga
-
É capaz de explicar melhor o que pretende?
-
Experimente ver no seguinte endereço
Criando um Loop
em VBA
Postado
Olá mazocco
Eu, Zav60, e Durutti_Black, somos apenas uma pessoa...
A sua Macro2 passa a isto:
Sub Macro2() ' Keyboard Shortcut: Ctrl+w Dim mLinha Dim Col 'Activa a worksheet2 Worksheets("Sheet2").Activate 'Para as colunas A a Z 'em que a A = 1 e a Z = 26 For Col = 1 To 26 'E para as linhas a trabalhar que começam na 11 'e vão até à 16 Set mLinha = Range(Cells(11, Col), Cells(16, Col)) 'se quiser até à última linha utilizada use antes esta: ' Set mLinha = Range(Cells(11, Col), _ ' Cells(Cells(Rows.Count, Col).End(xlUp).Row, Col)) 'Faz a ordenação tendo como linha inicial a 11 mLinha.Sort Key1:=Cells(11, Col) Next Col End SubExperimente e diga se funciona...