Doorzoeken van waarde en aanpassen

Status
Niet open voor verdere reacties.
I

Interface

Gebruiker
Lid geworden
27 jan 2009
Berichten
156
Voor mijn werk ben ik bezig met een script om een EAN code te controleren en als deze aan een bepaalde voorwaarde voldoet te wijzigen. Ik loop hier op vast.

Ik heb verschillende scripts geprobeerd zoals select case en if then etc.

In het onderstaande script is de code die ik nu gebruik en deze voldoet wel alleen op één of andere manier blijven waardes voorkomen.

Als ik bijvoorbeeld if len(range("b" &i)) = 6 then rows(i).delete en ik run de code. Dan blijven er waardes tussen staand die nog steeds 6 teken hebben???

De code die ik nu gebruik en dus niet helemaal werkt is:
Code: 
Private Sub CommandButton1_Click()
 
 Dim i As Integer
 
    Application.ScreenUpdating = False
    
        For i = 2 To Range("b2", Range("b2").End(xlDown)).Count + 1
            If Len(Range("b" & i)) = 13 Then
                Range("b" & i) = "*0" & Range("b" & i)
            End If
                If Len(Range("b" & i)) = 12 Then
                    Range("b" & i).Value = "*00" & Range("b" & i)
                End If
                    If Len(Range("b" & i)) = 11 Then
                        Range("b" & i) = "*000" & Range("b" & i)
                    End If
                        If Len(Range("b" & i)) = 10 Then
                            Rows(i).Delete
                        End If
                            If Len(Range("b" & i)) = 9 Then
                                Rows(i).Delete
                            End If
                                If Len(Range("b" & i)) = 8 And Left(Range("b" & i), 1) <> 2 Then
                                    Range("b" & i) = "*000000" & Range("b" & i)
                                End If
                                If Len(Range("b" & i)) = 8 And Left(Range("b" & i), 1) = 2 Then
                                    Rows(i).Delete
                                End If
                                    If Len(Range("b" & i)) = 7 And Left(Range("b" & i), 1) = 2 Then
                                        Rows(i).Delete
                                    End If
                                        Select Case Len(Range("b" & i)) = 7
                                            Case (Left(Range("b" & i), 2) <> 21 Or 23)
                                                Rows(i).Delete
                                            Case (Left(Range("b" & i), 2) = 21 Or 23)
                                                Range("b" & i).Value = "*0" & Left(Range("b" & i), 6) & (Left(Range("b" & i), 1) * 3) _
                                                    + (Right(Left(Range("b" & i), 2), 1) * 1) _
                                                        + (Right(Left(Range("b" & i), 3), 1) * 3) _
                                                            + (Right(Left(Range("b" & i), 4), 1) * 1) _
                                                                + (Right(Left(Range("b" & i), 5), 1) * 3) _
                                                                    + (Right(Left(Range("b" & i), 6), 1) * 1) _
                                                                        + (Right(Range("b" & i), 1) * 3) _
                                                                            - (Left(Range("b" & i), 1) * 3) _
                                                                                + (Right(Left(Range("b" & i), 2), 1) * 1) _
                                                                                    + (Right(Left(Range("b" & i), 3), 1) * 3) _
                                                                                        + (Right(Left(Range("b" & i), 4), 1) * 1) _
                                                                                            + (Right(Left(Range("b" & i), 5), 1) * 3) _
                                                                                                + (Right(Left(Range("b" & i), 6), 1) * 1) _
                                                                                                    + (Right(Range("b" & i), 1) * 3) & "000000"
                                        End Select
                                                If Len(Range("b" & i)) = 14 Then
                                                    Range("b" & i).Value = "*" & Range("b" & i).Value
                                                End If
                                                    If Len(Range("b" & i)) = 6 Then
                                                        Rows(i).Delete
                                                    End If
                                                        If Len(Range("b" & i)) = 5 Then
                                                            Rows(i).Delete
                                                        End If
                                                            If Len(Range("b" & i)) = 4 Then
                                                                Rows(i).Delete
                                                            End If
                                                                If Len(Range("b" & i)) = 3 Then
                                                                    Rows(i).Delete
                                                                End If
                                                                    If Len(Range("b" & i)) = 2 Then
                                                                        Rows(i).Delete
                                                                    End If
                                            
                                                    
        Next
    Application.ScreenUpdating = True

End Sub
 

Bijlagen

even nog wat aangepast...

Nu heb ik dit(onderstaande). Deze pakt ook weer neit alles, echter als ik for ... each ... er voor zet gaat alles goed. Dit werkt wel bij een klein bestand, maar het uiteindelijk bestand heeft 15000 regels. Dat gaat dan dus heeeeel lang duren... Is hier geen oplossing voor?

Code: 
 Dim i As Integer
 Dim intJoas21 As Integer
 Dim intJoas21AfrondnBoven As Integer
 Dim intJoas221 As Integer
 Dim bytJoas21totaal As Byte
 Dim intJoas23 As Integer
 Dim intJoas23AfrondnBoven As Integer
 Dim intJoas223 As Integer
 Dim bytJoas23totaal As Byte
 
    Application.ScreenUpdating = False
    
    
        For i = 2 To Range("b2", Range("b2").End(xlDown)).Count + 1
            If Len(Range("b" & i)) = 14 Then Range("b" & i) = "*" & Range("b" & i)
                If Len(Range("b" & i)) = 13 Then Range("b" & i) = "*0" & Range("b" & i)
                    If Len(Range("b" & i)) = 12 Then Range("b" & i) = "*00" & Range("b" & i)
                        If Len(Range("b" & i)) = 11 Then Range("b" & i) = "*000" & Range("b" & i)
                            If Len(Range("b" & i)) = 10 Then Rows(i).Delete
                                If Len(Range("b" & i)) = 9 Then Rows(i).Delete
                                    If Len(Range("b" & i)) = 8 And Left(Range("b" & i), 1) = 2 Then Rows(i).Delete
                                        If Len(Range("b" & i)) = 8 And Left(Range("b" & i), 1) <> 2 Then Range("b" & i) = "*000000" & Range("b" & i)
                                            If Len(Range("b" & i)) = 7 And Left(Range("b" & i), 2) = 21 Then
                                                    intJoas21 = (Left(Range("b" & i), 1) * 3) _
                                                        + (Right(Left(Range("b" & i), 2), 1) * 1) _
                                                            + (Right(Left(Range("b" & i), 3), 1) * 3) _
                                                                + (Right(Left(Range("b" & i), 4), 1) * 1) _
                                                                    + (Right(Left(Range("b" & i), 5), 1) * 3) _
                                                                        + (Right(Left(Range("b" & i), 6), 1) * 1) _
                                                                            + (Right(Range("b" & i), 1) * 3)
                                                                                If intJoas21 < 10 Then
                                                                                    intJoas21AfrondnBoven = 10
                                                                                Else
                                                                                    intJoas21AfrondnBoven = Left(intJoas21, 1) + 1 & "0"
                                                                                End If
                                                    bytJoas21totaal = intJoas21AfrondnBoven - intJoas21
                                                Range("b" & i) = "*0" & Left(Range("b" & i), 7) & "00000" & CStr(bytJoas21totaal)
                                            End If
                                                If Len(Range("b" & i)) = 7 And Left(Range("b" & i), 2) = 23 Then
                                                        intJoas23 = (Left(Range("b" & i), 1) * 3) _
                                                            + (Right(Left(Range("b" & i), 2), 1) * 1) _
                                                                + (Right(Left(Range("b" & i), 3), 1) * 3) _
                                                                    + (Right(Left(Range("b" & i), 4), 1) * 1) _
                                                                        + (Right(Left(Range("b" & i), 5), 1) * 3) _
                                                                            + (Right(Left(Range("b" & i), 6), 1) * 1) _
                                                                                + (Right(Range("b" & i), 1) * 3)
                                                                                    If intJoas23 < 10 Then
                                                                                        intJoas23AfrondnBoven = 10
                                                                                    Else
                                                                                        intJoas23AfrondnBoven = Left(intJoas23, 1) + 1 & "0"
                                                                                    End If
                                                            bytJoas23totaal = intJoas23AfrondnBoven - intJoas23
                                                        Range("b" & i) = "*0" & Left(Range("b" & i), 7) & "00000" & CStr(bytJoas23totaal)
                                                End If
                                                    If Len(Range("b" & i)) = 7 Then Rows(i).Delete
                                                    If Len(Range("b" & i)) = 6 Then Rows(i).Delete
                                                        If Len(Range("b" & i)) = 5 Then Rows(i).Delete
                                                            If Len(Range("b" & i)) = 4 Then Rows(i).Delete
                                                                If Len(Range("b" & i)) = 3 Then Rows(i).Delete
                                                                    If Len(Range("b" & i)) = 2 Then Rows(i).Delete
                                                                        If Len(Range("b" & i)) = 1 Then Rows(i).Delete
                                                                            If Len(Range("b" & i)) = 0 Then Rows(i).Delete
                                                                                If Len(Range("b" & i)) > 15 Then Rows(i).Delete
        Next
 
Als je rijen gaat verwijderen door een tellertje te verhogen, ga je altijd problemen kunnen hebben, aangezien rijen opschuiven naar boven bij het verwijderen... Daarom: werk van onder naar boven.
 
Gebruik ook beter:

Code: 
    Select Case Len(Range("b" & i).Value)
    
        Case 0 To 7, Is > 15: Rows(i).Delete
        
    End Select

ipv

Code: 
    If Len(Range("b" & i)) = 7 Then Rows(i).Delete
    If Len(Range("b" & i)) = 6 Then Rows(i).Delete
    If Len(Range("b" & i)) = 5 Then Rows(i).Delete
    If Len(Range("b" & i)) = 4 Then Rows(i).Delete
    If Len(Range("b" & i)) = 3 Then Rows(i).Delete
    If Len(Range("b" & i)) = 2 Then Rows(i).Delete
    If Len(Range("b" & i)) = 1 Then Rows(i).Delete
    If Len(Range("b" & i)) = 0 Then Rows(i).Delete
    If Len(Range("b" & i)) > 15 Then Rows(i).Delete

Wigi
 
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan