FranciscoF 0 Posted January 22, 2011 Report Share Posted January 22, 2011 Antes de mais, boa noite a todos os foristas. Sou um recém utilizador de VBA e ainda estou a dar os meus 1ºs passos. Já tenho alguns conhecimentos de C e C++, que me permitem um raciocinio bom em pseudo-código, mas a parte da sintaxe ainda está mt pobre. Conheci o fórum na internet pois era um link recorrente nas buscas que fiz para tirar dúvidas (muitas) que encontrei. O objectivo do meu código é percorrer uma lista de várias colunas da data + recente para a mais antiga e reconhecer o valor 0101 numa coluna. Qd reconhece essa valor percorre a lista a partir dessa data no sentido da data + recente para identificar o nº de vezes o mesmo material e fornecedor voltam a aparecer. Sub avalia_skip_v3() Dim i As Integer Dim j As Integer Dim data_S0 As Date Dim Row_inv As Integer Dim Column_size As Long Dim N1 As ListColumn Dim N2 As ListColumn Dim Row As Long Dim Regra_Skip As Worksheet Dim material As Double Dim fornecedor As Double Set Regra_Skip = Sheets.Add j = 2 i = 2 'saber o tamanho da lista: Column_size = Sheets("Sheet1").Range("A:A") 'Ciclo decrescente, em data, para encontrar código 0101 e qd encontra, passa toda a linha para a página criada For Row = Column_size To i If Cells(Row, "TpCtrl.").Value = "0101" Then ActiveCell.RowRange.Select Selection.Copy Sheets("Regra_Skip").Activate Sheets("Regra_Skip").Range.Row(j).Select Selection.PasteSpecial Paste:=xlPasteValues Selection.Clear ' cria coluna na nova folha para armazenar diferença entre datas Sheets("Regra_Skip").ListColumns.Add = N1 N1.Name = "Data desde S0" ' executa a diferença entre datas Cells(j, "Data desde S0") = DateDiff("ym", Now, Data fim) ' cria coluna na nova folha para armazenar contador de series normais Sheets("Regra_Skip").ListColumns.Add = N2 N2.Name = "Nº Series Normal" 'guarda material e fornecedor para ler series 01 posteriores referentes a esses valores. material = Cells(Row, "Material") fornecedor = Cells(Row, "Fornecedor") 'faz contador para Serie 01 'Conta numero de series 01 desde a ocorrencia da Serie 0101 em direção às mais recentes For Row_inv = Row To Column_size If Cells(Row_inv, "Material") = material And Cells(Row_inv, "Fornecedor") = fornecedor Then If Not Cells(Row_inv, "Code DU") = “9” Then Sheets("Regra_Skip").Cells(j, "Nº Series Normal").Value = Cells(j, "Nº Series Normal").Value + 1 End If End If j = j + 1 Next Row_inv End If Next Row End Sub Este código é para aplicar na seguinte lista: LotCtrl Material Texto breve do objeto de controle Status do sistema Skip Fornecedor TpCtrl. Code DU Qtd.lote DtaInício Data fim 010400781444 6-720-006-339 Esferovite inferior DU CNTC ESTD COIM ESAT 140646 01 1 96,000 06-08-2010 06-08-2010 010400782418 6-720-006-339 Esferovite inferior DU CNTC ESTD COIM ESAT 140646 01 1 192,000 09-08-2010 09-08-2010 010400831238 6-720-006-343 Caixa de cartao 473x769x268 DU CNTC ESTD COIM ESAT 657793 0101 5 304,000 24-11-2010 24-11-2010 010400829969 6-720-006-344 Caixa de cartao 468x825x290 DU CNTC ESTD COIM ESAT 657793 0101 5 320,000 22-11-2010 22-11-2010 010400814858 6-720-007-028 CAIXA DE CARTÃO DU CNTC ESTD COIM ESAT 657593 0101 5 3,000 22-10-2010 22-10-2010 010400827268 6-720-007-028 CAIXA DE CARTÃO DU CNTC ESTD COIM ESAT 657593 0101 1 250,000 17-11-2010 17-11-2010 010400840436 6-720-007-028 CAIXA DE CARTÃO DU CNTC ESTD COIM ESAT 657593 0101 1 3,000 14-12-2010 14-12-2010 010400813985 6-720-007-116 Caixa de Cartao DU CNTC ESTD COIM ESAT 657593 0101 1 250,000 21-10-2010 21-10-2010 010400814870 6-720-007-116 Caixa de Cartao DU CNTC ESTD COIM ESAT 657593 0101 1 3,000 22-10-2010 22-10-2010 010400793851 6-720-007-205 CAIXA DE CARTÃO DU CNTC ESTD COIM ESAT 657593 01 1 225,000 09-09-2010 09-09-2010 010400794393 6-720-007-205 CAIXA DE CARTÃO DU CNTC ESTD COIM ESAT 657593 01 1 135,000 10-09-2010 10-09-2010 010400781331 6-720-007-206 CAIXA DE CARTÃO DU CNTC ESTD COIM ESAT 657593 01 1 240,000 06-08-2010 06-08-2010 010400759725 6-720-007-221 PALETE 1200x1000 C/ TRAT. TERMICO DU CNTC ESTD COIM ESAT 657553 01 1 65,000 24-06-2010 24-06-2010 010400761030 6-720-007-221 PALETE 1200x1000 C/ TRAT. TERMICO DU CNTC ESTD COIM ESAT 657553 01 1 50,000 28-06-2010 28-06-2010 010400764097 6-720-007-221 PALETE 1200x1000 C/ TRAT. TERMICO DU CNTC ESTD COIM ESAT 657553 01 1 108,000 02-07-2010 02-07-2010 010400768680 6-720-007-221 PALETE 1200x1000 C/ TRAT. TERMICO DU CNTC ESTD COIM ESAT 657918 0101 9 10,000 12-07-2010 12-07-2010 010400824922 6-720-007-221 PALETE 1200x1000 C/ TRAT. TERMICO DU CNTC ESTD COIM ESAT 657918 0101 1 10,000 12-11-2010 12-11-2010 010400805955 6-720-007-233 Caixa de Cartao 600x400x340 DU CNTC ESTD COIM ESAT 657793 01 1 400,000 04-10-2010 04-10-2010 010400803228 6-720-007-239 Caixa de Cartao 300x200x120 DU CNTC ESTD COIM ESAT 657793 01 1 960,000 28-09-2010 28-09-2010 010400835347 6-720-007-241 Caixa de Cartao 400x300x220 DU CNTC ESTD COIM ESAT 657793 01 1 320,000 03-12-2010 03-12-2010 010400762519 6-720-007-254 Caixa de Madeira 640x640x400 DU CNTC ESTD COIM ESAT 657918 01 1 4,000 30-06-2010 30-06-2010 010400827976 6-720-007-269 Caixa de cartao DU CNTC ESTD COIM ESAT 657700 01 1 285,000 18-11-2010 18-11-2010 010400749693 6-720-007-271 Caixa Impressa Compact 16 L DU CNTC ESTD COIM ESAT 657593 0101 10 3,000 02-06-2010 02-06-2010 010400781370 6-720-007-271 Caixa Impressa Compact 16 L DU CNTC ESTD COIM ESAT 657593 0101 1 320,000 06-08-2010 06-08-2010 010400781860 6-720-007-271 Caixa Impressa Compact 16 L DU CNTC ESTD COIM ESAT 657593 0101 1 3,000 07-08-2010 07-08-2010 010400797403 6-720-007-271 Caixa Impressa Compact 16 L DU CNTC ESTD COIM ESAT 657593 01 1 320,000 16-09-2010 16-09-2010 010400749691 6-720-007-272 Caixa Impressa Compact 11 L DU CNTC ESTD COIM ESAT 657593 0101 10 3,000 02-06-2010 02-06-2010 010400781371 6-720-007-272 Caixa Impressa Compact 11 L DU CNTC ESTD COIM ESAT 657593 0101 1 312,000 06-08-2010 06-08-2010 010400781861 6-720-007-272 Caixa Impressa Compact 11 L DU CNTC ESTD COIM ESAT 657593 0101 1 3,000 07-08-2010 07-08-2010 010400813940 6-720-007-272 Caixa Impressa Compact 11 L DU CNTC ESTD COIM ESAT 657593 01 1 320,000 21-10-2010 21-10-2010 010400756057 6-720-007-273 Caixa de cartao 465x100x420 DU CNTC ESTD COIM ESAT 657593 0101 1 255,000 17-06-2010 17-06-2010 010400757317 6-720-007-273 Caixa de cartao 465x100x420 DU CNTC ESTD COIM ESAT 657593 0101 1 3,000 21-06-2010 21-06-2010 010400827260 6-720-007-273 Caixa de cartao 465x100x420 DU CNTC ESTD COIM ESAT 657593 01 1 320,000 17-11-2010 17-11-2010 010400824269 6-720-074-047 Caixa de Cartao DU CNTC ESTD COIM ESAT 657593 0101 5 250,000 11-11-2010 11-11-2010 010400836826 6-720-074-047 Caixa de Cartao DU CNTC ESTD COIM ESAT 657593 0101 5 3,000 07-12-2010 07-12-2010 010400833941 6-720-150-301 FITA ADESIVA INTERMITENTE P/ESQ. DU CNTC ESTD COIM ESAT X 655043 01 1 1.440,000 30-11-2010 30-11-2010 010400753751 6-720-370-009 Absorber fixation assembeld DU CNTC ESTD COIM ESAT 97077447 01 1 800,000 14-06-2010 14-06-2010 010400761897 6-720-370-009 Absorber fixation assembeld DU CNTC ESTD COIM ESAT 97077447 01 1 800,000 29-06-2010 29-06-2010 010400768808 6-720-370-009 Absorber fixation assembeld DU CNTC ESTD COIM ESAT 97077447 01 1 800,000 12-07-2010 12-07-2010 A depurar o código tenho um erro no 1º If e tenho dúvidas sobre a forma como me posso referir a colunas, no caso "TpCtrl." se o ponto existente no final atrapalha ou não. Aguardo o vosso feedback e agradeço desde já a ajuda. Cumps! Link to post Share on other sites
jpaulino 90 Posted January 23, 2011 Report Share Posted January 23, 2011 Olá, Em primeiro lugar bem vindo à comunidade. Relativamente à primeira utilização do If, está errada (como o compilado já te disse). O sintaxe é o seguinte: If cells(linha, coluna).Value = critério Then Podendo ser indicado na coluna um número (index) ou a coluna (letra). Nesse caso deverá ser 8 ou "h". If Cells(Row, "h").Value = "0101" Then ' código End If Isto aplica-se, obviamente, para as restantes utilizações no código. Link to post Share on other sites
FranciscoF 0 Posted January 23, 2011 Author Report Share Posted January 23, 2011 Obrigado Jpaulino pela óptima recepção! Vou corrigir e ver como corre. O teu esclarecimento aponta para uma das minhas falhas de formação que já identifiquei, a dificuldade em fazer a ligação VBA - Excel. Estou a ler um livro sobre Excel 2003 que é o que uso, de Jonh Walkenbach, mas tenho outros como o do MrExcel para o Excel 2010. Será boa prática estudar pelo livro do Excel 2010 quando estou a utilizar o Excel 2003? A pergunta se calhar até é bastante ignorante, mas como te disse sou muito maçarico ainda em VBA. Cumprimentos, Francisco. Link to post Share on other sites
jpaulino 90 Posted January 23, 2011 Report Share Posted January 23, 2011 Estou a ler um livro sobre Excel 2003 que é o que uso, de Jonh Walkenbach, mas tenho outros como o do MrExcel para o Excel 2010. Será boa prática estudar pelo livro do Excel 2010 quando estou a utilizar o Excel 2003? A pergunta se calhar até é bastante ignorante, mas como te disse sou muito maçarico ainda em VBA. A diferença é minima e não há problema algum. É melhor até aprender em versões posteriores (2007 e 2010) pois as versões são mais exigentes (segurança, versões dos ficheiros, etc). Tenho dado formação para utilizadores de Excel 2003 em Excel 2010 e a adaptação é rápida. Link to post Share on other sites
FranciscoF 0 Posted January 24, 2011 Author Report Share Posted January 24, 2011 Olá bom dia! Já corrigi o código mas penso que não avança a partir do 1º ciclo For. Nem sequer executa o 1º IF. O que faz é criar uma nova folha e indicar o tamanho da lista. Será que o problema está no meu ciclo For? Como estou a implementar uma contagem decrescente, basta indicar no For inicial os valores iniciais e finais que apesar de ter next no final ele fará a contagem decrescente? Outra pergunta, para não ser muito chato... ;-). O meu código começa e acaba com a condição IF que está dentro do ciclo For, mas se a condição que indiquei para o If não se verificar, supostamente, o programa deve voltar a testar a condição IF, porque atinge o Next Row do final do código e por isso volta ao 1º If, certo? Cumprimentos a todos Link to post Share on other sites
jpaulino 90 Posted January 24, 2011 Report Share Posted January 24, 2011 Tens alguns erros e não é facil enumerar todos ... é normal de inicio, mas vai com calma. Isto deve dar-te um errro (ou zero) Column_size = Sheets(1).Range("A:A") Depois se queres em dias deves indicar "d" e não "ym" (que até acho que não funciona ... não testei). Além disso Data fim não é válido. DateDiff("ym", Now, Data fim) Mostra lá como tens o código agora e onde tens mais erros! Link to post Share on other sites
FranciscoF 0 Posted January 24, 2011 Author Report Share Posted January 24, 2011 Boa tarde, JPaulino! Mais uma vez obrigado pela ajuda. Já estou a avançar no programa, mas os erros abundam, é um facto. Bom, isto está um bocado confuso, porque eu vou testando novas coisas e deixo as antigas como comentário, caso a coisa dê para o torto... Estou a testar com um MsgBox em diferentes pontos para saber até onde está a ler o código. Sobre o Datediff, tinha colocado "ym" porque queria que o resultado aparecesse em meses, e desde que coloquei o 1º For como comentário, porque não estava a avançar no ciclo, o erro tá aí. Neste momento está assim: Option Explicit Sub avalia_skip_v3() 'Avalia_Skip gravada por utilizador FEF1AV a 19/01/2011 Dim i As Long Dim j As Long Dim data_S0 As Date Dim Row_inv As Long Dim Column_size As Variant Dim N1 As ListColumn Dim N2 As ListColumn Dim Row As Long Dim material As Double Dim fornecedor As Double Dim Regra_Skip As Worksheet, flg As Boolean For Each Regra_Skip In Worksheets If Regra_Skip.Name Like "Regra_Skip" Then flg = True: Exit For Next If flg = True Then MsgBox "Found!" Else Sheets.Add.Name = "Regra_Skip" End If ' Set Regra_Skip = Sheets.Add ' If Worksheets("Regra_Skip") = False Then ' Worksheets.Add().Name = "Regra_Skip" ' End If Sheets("Sheet1").Activate ' Rows("1").Copy Destination:=Sheets("Regra_Skip").Range("1") j = 2 i = 2 'saber o tamanho da lista: Column_size = Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row 'Ciclo decrescente, em data, para encontrar Series 0 ' MsgBox "The count is " & Column_size Row = Column_size ' For Row = Column_size To i ' If Cells(Row, "TpCtrl") = "0101" Then ' If Worksheets("Sheet1").Cells(Row, "TpCtrl").Value = "0101" If Cells(Row, "F").Value = 101 Then ' MsgBox "The count is " & Column_size Rows(Row).Copy Destination:=Sheets("Regra_Skip").Range("A" & Rows.Count).End(xlUp).Offset(1) ' ActiveCell.RowRange.Select ' Selection.Copy ' Sheets("Regra_Skip").Activate ' Sheets("Regra_Skip").Range.Row(j).Select ' Selection.PasteSpecial Paste:=xlPasteValues ' Selection.Clear ' cria coluna na nova folha para armazenar diferença entre datas Sheets("Regra_Skip").Columns("K:K").EntireColumn.Insert Sheets("Regra_Skip").Cells(j, "K:K").Name = "Data_desde_S0" ' Sheets("Regra_Skip").ListColumns.Add = N1 ' N1.Name = "Data desde S0" ' executa a diferença entre datas Cells(j, "K:K") = DateDiff("ym", Now, "J:J") ' cria coluna na nova folha para armazenar contador de series normais Sheets("Regra_Skip").ListColumns.Add = N2 N2.Name = "Nº Series Normal" 'guarda material e fornecedor para ler series normais posteriores referentes a esses valores. material = Cells(Row, "B") fornecedor = Cells(Row, "E") 'faz contador para Serie Normal 'Conta numero de series normais da data da Serie 0 para as mais recentes For Row_inv = Row To Column_size If Cells(Row_inv, "B") = material And Cells(Row_inv, "E") = fornecedor Then If Not Cells(Row_inv, "G") = "9" Then Sheets("Regra_Skip").Cells(j, "Nº Series Normal").Value = Cells(j, "Nº Series Normal").Value + 1 End If End If j = j + 1 Next Row_inv End If Column_size = Column_size - 1 ' Next Row End Sub O que me parece é que quando a 1ª linha que o programa lê (neste caso é a ultima da lista) não possui o valor 101 o código perde-se porque o If não é executado pois a condição é falsa e o For não funciona. Obrigado pela ajuda, cumps. Link to post Share on other sites
FranciscoF 0 Posted January 24, 2011 Author Report Share Posted January 24, 2011 Bom, acho que o código já está a ficar muito confuso, e ainda falta um ciclo IF para verificar se não estou a repetir materiais e fornecedores na nova folha, por isso acho que o melhor é começar a fazer uma coisa limpa. Já estou há algum tempo a tentar saber como funciona o DateDiff mas não está fácil... E gostaria de poder fazer as referências às colunas pelo seu nome e não pela letra, mas se não puder... C'est lá vie! Obrigado pelo interesse e pela ajuda. Vou dando notícias! Link to post Share on other sites
jpaulino 90 Posted January 24, 2011 Report Share Posted January 24, 2011 Não há maneira mais fácil do que seleccionar a função, neste caso o Datediff e pressionar F1 Link to post Share on other sites
FranciscoF 0 Posted January 25, 2011 Author Report Share Posted January 25, 2011 Lololol bem visto JPaulino! (Só hoje é que vi qual a tecla de atalho para o help do Excel...) Acho que vou começar o programa de raiz e testar cada módulo. Também tenho encontrado macros do Excel, como o Vlookup, etc, que me podem ajudar na minha tarefa e andar a consertar o programa com erros ajuda-me a ganhar experiencia, mas torna tudo mais confuso. Vou atacar o programa de novo e quando obtiver resultados posto o código. Em qualquer dos casos, obrigado pela ajuda! Link to post Share on other sites
FranciscoF 0 Posted March 4, 2011 Author Report Share Posted March 4, 2011 Olá boa tarde! Depois de muitas tentativas e erro consegui finalmente executar o código que queria. Neste momento ainda demora bastante tempo a correr, mas acho que não há muito a fazer , em função dos ciclos que implementei. Option Explicit Sub Elimina_Incoming() ' Macro implementada a 15.02 por FEF1AV Dim Tamanho As Long Dim Row As Variant Dim j As Variant Dim ref As Variant Dim fornecedor As Variant Dim S01 As Variant Dim ContS01 As Integer Dim difdata As Date Dim S0_repet As Integer Dim C_PPM As Integer Dim T_Skip As Integer Dim PPM_RS As Integer Dim ref_PPM As Variant Dim data_rej As Date Dim data_rejdif As Integer j = 1 ' cria nova folha Worksheets.Add , after:=Sheets(1) Sheets(2).Name = ("Regra_Skip") ' cria o cabeçalho Sheets(1).Activate Cells(1).EntireRow.Select Selection.Copy Sheets("Regra_Skip").Activate Selection.PasteSpecial Paste:=xlPasteValues ' cria as 4 colunas Cells(1, "I").Value = "Nº Series Normais" Cells(1, "J").Value = "Meses Ok" Cells(1, "K").Value = "Data rejeição" Cells(1, "L").Value = "PPM Ok?" Sheets(1).Activate 'saber o tamanho da lista: Tamanho = ActiveSheet.UsedRange.Rows.Count Row = Tamanho 'Ciclo para as series 0 Do Until Row = 2 Cells(Row, "A").EntireRow.Select If Cells(Row, "F").Value = 101 And Cells(Row, "G").Value = 1 Then ' guarda referencia e fornecedor ref = Cells(Row, "B") fornecedor = Cells(Row, "E") ' avalia a presença de S0 repetidas em Regra Skip Sheets("Regra_Skip").Activate For S0_repet = 1 To j If Cells(S0_repet, "B") = ref And Cells(S0_repet, "E") = fornecedor Then GoTo a: Next S0_repet j = j + 1 Sheets(1).Activate Cells(Row, "A").EntireRow.Select ' executa a diferença de datas difdata = DateDiff("m", Cells(Row, "H"), Now) Selection.Copy Sheets("Regra_Skip").Activate Cells(j, "A").EntireRow.Select Selection.PasteSpecial Paste:=xlPasteValues Cells(j, "J") = difdata Sheets(1).Activate Cells(Row, "A").EntireRow.Delete ' Conta Nº se Series normais desde S0 ContS01 = 0 S01 = Row Do Until S01 = Tamanho Cells(S01, "A").EntireRow.Select If Cells(S01, "B") = ref And Cells(S01, "E") = fornecedor Then If Cells(S01, "G") = "0" Or Cells(S01, "G") = "1" Or Cells(S01, "G") = "3" Then ContS01 = ContS01 + 1 Else ContS01 = 0 data_rej = Cells(S01, "H") data_rejdif = DateDiff("m", Cells(S01, "H"), Now) Sheets("Regra_Skip").Activate Cells(j, "K") = data_rej Cells(j, "J") = data_rejdif Sheets(1).Activate End If Cells(S01, "A").EntireRow.Delete S01 = S01 - 1 Tamanho = Tamanho - 1 End If S01 = S01 + 1 Loop Sheets("Regra_Skip").Activate Cells(j, "I") = ContS01 End If a: Sheets(1).Activate Row = Row - 1 Loop ' testa PPM para a lista obtida com 93 PPM >0 For C_PPM = 7 To 94 Sheets("s911").Activate If Cells(C_PPM, "I") > 100 Then ref_PPM = Cells(C_PPM, "T") Sheets("Regra_Skip").Activate T_Skip = 564 For PPM_RS = 2 To T_Skip Cells(PPM_RS, "A").EntireRow.Select If Cells(PPM_RS, "B") = ref_PPM Then Cells(PPM_RS, "L").Value = "Não" End If Next PPM_RS End If Next C_PPM MsgBox "Fim!" End Sub Podem colocar o tópico como resolvido! E obrigado pela ajuda! Cumps! Link to post Share on other sites
jpaulino 90 Posted March 4, 2011 Report Share Posted March 4, 2011 Neste momento ainda demora bastante tempo a correr, mas acho que não há muito a fazer , em função dos ciclos que implementei. Vê se estas dicas ajudam: Excel: Dicas de VBA - Performance Link to post Share on other sites
Recommended Posts
Create an account or sign in to comment
You need to be a member in order to leave a comment
Create an account
Sign up for a new account in our community. It's easy!
Register a new accountSign in
Already have an account? Sign in here.
Sign In Now