1
votes

Comment filtrer les 12 chiffres du code?

Bonjour à tous et merci pour votre temps, mon premier message et je suis un débutant total.

J'essaye de filtrer n'importe quel numéro à 12 chiffres dans la colonne B pour les couper plus tard dans une autre feuille nommée PPE.

Comment écrire un code pour faire cela? Dans l'exemple ci-dessous, cela fonctionne parfaitement mais uniquement pour 243080700547.

J'ai également fourni une capture d'écran.

I = Worksheets("RAW DATA").UsedRange.Rows.Count
J = Worksheets("PPE").UsedRange.Rows.Count

If J = 1 Then
    If Application.WorksheetFunction.CountA(Worksheets("PPE").UsedRange) = 0 Then J = 0
End If

Set xRg = Worksheets("RAW DATA").Range("C1:C" & I)

On Error Resume Next
Application.ScreenUpdating = False

For K = 1 To xRg.Count
    If CStr(xRg(K).Value) = "243080700547" Then
        xRg(K).EntireRow.Copy Destination:=Worksheets("PPE").Range("A" & J + 1)
        xRg(K).EntireRow.Delete

        If CStr(xRg(K).Value) = "243080700547" Then
            K = K - 1
        End If

        J = J + 1
    End If
Next

excel vba

0 commentaires

3 Réponses :

0
votes

Au lieu de votre première apparition de

Si CStr (xRg (K) .Value) = "243080700547" Alors

vous pouvez utiliser

Si Len (CStr (xRg (K) .Value)) = 12 Alors

pour vérifier si la chaîne a une longueur de 12.

Question: Pourquoi le vérifiez-vous une deuxième fois? Vous êtes déjà dans le bloc If de ce même (premier) contrôle.

1 commentaires

Merci pour votre réponse, cela fonctionne très bien, je ne sais pas pourquoi cela a été répété, je n'ai pas écrit ce code, je l'ai juste copié à partir du code de quelqu'un d'autre.

4
votes

Vous utilisez un cast en chaîne via CStr, donc je suppose que les valeurs de la colonne C sont de vrais nombres. Dans ce cas, un simple plus grand que / moins que devrait suffire.

Travaillez de bas en haut et vous pouvez éviter de modifier l'incrément.

with Worksheets("RAW DATA")

  I = .cells(.rows.count, "C").end(xlup).row
  For K = I To 1 step -1
    If .cells(K, "C").value2 > 99999999999 And  .cells(K, "C").value2 <= 999999999999 Then
        J = J + 1
        .rows(K).EntireRow.Copy Destination:=Worksheets("PPE").Range("A" & J)
        .rows(K).EntireRow.delete
    End If
  Next K

end with

2 commentaires

Merci beaucoup pour cela, cela a parfaitement fonctionné et j'ai utilisé celui-ci. Le seul changement que j'y ai apporté a été de faire de ... Range ("A" & J) into ... Range ("A" & J + 1)

Comme la première ligne était un en-tête et qu'elle l'écrasait.

0
votes

Vous pouvez utiliser un filtre au lieu de boucler sur toute la date, ce qui pourrait être beaucoup plus rapide que de copier ligne par ligne, car vous copiez en une seule fois.

Cela fonctionnera également pour tous les autres critères, il vous suffit de ajustez le .AutoFilter.

Option Explicit

Public Sub FilterAndCopy()
    Dim DestRow As Long 'find destination row
    DestRow = Worksheets("PPE").Cells(Worksheets("PPE").Rows.Count, "A").End(xlUp).Row + 1

    With Worksheets("RAW DATA").UsedRange
        'filter
        .AutoFilter Field:=3, Criteria1:=">=100000000000", Operator:=xlAnd, Criteria2:="<=999999999999"
        'copy date (without headers)
        .Resize(RowSize:=.Rows.Count - 1).Offset(RowOffset:=1).SpecialCells(xlCellTypeVisible).EntireRow.Copy Destination:=Worksheets("PPE").Cells(DestRow, "A")
        'remove filter
        .AutoFilter
    End With
End Sub

0 commentaires