Jump to content
FranciscoF

Código VBA com contadores a percorrerem direcções opostas

Recommended Posts

FranciscoF

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!

Share this post


Link to post
Share on other sites
jpaulino

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.

Share this post


Link to post
Share on other sites
FranciscoF

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.

Share this post


Link to post
Share on other sites
jpaulino

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.

Share this post


Link to post
Share on other sites
FranciscoF

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

Share this post


Link to post
Share on other sites
jpaulino

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!

Share this post


Link to post
Share on other sites
FranciscoF

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.

Share this post


Link to post
Share on other sites
FranciscoF

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!

Share this post


Link to post
Share on other sites
jpaulino

Não há maneira mais fácil do que seleccionar a função, neste caso o Datediff e pressionar F1 :)

Share this post


Link to post
Share on other sites
FranciscoF

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!

Share this post


Link to post
Share on other sites
FranciscoF

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!  :P

Share this post


Link to post
Share on other sites

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 account

Sign in

Already have an account? Sign in here.

Sign In Now

×
×
  • Create New...

Important Information

By using this site you accept our Terms of Use and Privacy Policy. We have placed cookies on your device to help make this website better. You can adjust your cookie settings, otherwise we'll assume you're okay to continue.