VBA Excel filtre le contenu de chaîne spécifique dans une colonne entière et le colle dans une autre colonne - excel, string, vba, excel-vba

J'ai une matrice d'environ 5000 lignes qui ressemble à quelque chose comme on le voit sur im1 (pas la vraie matrice)

im1

En gros, j'ai codé quelque chose qui insère 3 colonnes vides à droite du fil / tuyau / type avec les noms respectifs "Fil, Taille et Couleur" écrites dans la cellule du haut de la colonne

La colonne Fil / Tuyau / Type contient 3 types deinformation le premier serait la chaîne de 4 caractères commençant par un nombre (comme 3FEC ou 4LOP). c'est un motif le second est un nombre comme 2.5 ou 0.50 la troisième est la chaîne qui contient une ou deux couleurs (GN ou GN / BN par exemple)

Ce que je veux faire, c'est identifier le premier type deinformations dans chaque cellule de la colonne et collez-le sur "Fil", pour coller le deuxième type d'informations sur "taille" et le troisième sur "couleur" et enfin supprimer la colonne Type de fil / tuyau de sorte que finalement il ressemble à quelque chose comme vu sur im2:

im2

Si quelqu'un pouvait me guider un peu surRemplir au moins le premier paramètre pour que je puisse remplir le reste avec le même raisonnement Je l’apprécierais vraiment, je ne veux pas dire cliché, mais je suis un peu nouveau dans cet environnement de codage

mon code ressemble jusqu'ici à ceci:

Sheet3.Activer

For i = 1 To 4
celltxt2 = ActiveSheet.Cells(1, i).Text
If InStr(1, celltxt2, "Wire/Hose/Tube type") Then
Columns(i + 1).EntireColumn.Select
Selection.Insert Shift:=xlToRight
Selection.Insert Shift:=xlToRight
Selection.Insert Shift:=xlToRight
End If
Next i
o = 1
Do While IsEmpty(Cells(1, o)) = False
o = o + 1
Loop
Set wr = Cells(1, o)
wr.Value = "Wire"
Set sz = Cells(1, o + 1)
sz.Value = "Size"
Set clr = Cells(1, o + 2)
clr.Value = "Color"

Je vous remercie!

Réponses:

C'est la façon de le faire.

Sub ProcessData()
Dim x As Long, y As Long
Dim r As Range
Dim values As Variant

With Sheet3
For y = 1 To 4
If InStr(1, Cells(1, y).value, "Wire/Hose/Tube type") Then
.Columns(y).Resize(, 3).Insert Shift:=xlToRight
Exit For
End If
Next
y = y + 3

For Each r In .Range(.Cells(2, y), .Cells(.Rows.Count, y).End(xlUp))
values = Split(Replace(r.value, ":", "-"), "-")
r.Offset(0, -3).value = values(1)
r.Offset(0, -2).value = values(2)
r.Offset(0, -1).value = values(3)
Next
.Cells(1, y - 3).Resize(1, 3).value = Array("Wire", "Size", "Color")
.Columns(y).Delete
End With

End Sub