XL 2010 Extraire les chiffres et les lettres dans un ordre dans une cellule

Trappa

XLDnaute Nouveau
Bonjour ,

Je sollicite votre aide pour finaliser un programme.

J'ai un classer excel avec deux feuilles.

dans la première feuille, j'ai des cellules avec des ce format : **C3=quesC13** , ** C11=varC8. les C correspondent aux colonnes de la deuxième feuille, C3est la colonne 3 de la feuille 2...
dans la deuxième feuilles, j'ai des données en colonne.

Mon but est de parcourir la feuille 1, s’arrêter dans ce genre de cellule **C3=quesC13**, Vérifier que la cellule C3 = ques (colonne 3 de la feuille 2) , si c'est bon, sur la même ligne récupérer la valeur de la cellule C13 (feuille 2) et la copier à la place de la cellule **C3=quesC13** (feuille 1).

J'ai réussi à extraire la partie texte pour la comparer mais je n'arrive pas à récupérer 3 à part et 13 à part.
J'ai pensé à récupérer les chiffres, mais je n'arrive pas à les dissocier

Num = "*=C0123456789"
texte = Cells.Value

For k = 1 To Len(Cells.Value)
texte = Replace(texte, Mid(Num, k, 1), "")

nombre = IIf(Mid(texte, k, 1) Like "*[0-9]*", nombre & " " & Mid(texte, k, 1), nombre)
Next k
MsgBox texte
MsgBox nombre

Est ce que vous pouvez m'aider?
 

Trappa

XLDnaute Nouveau
Bonjour ,

Je sollicite votre aide pour finaliser un programme.

J'ai un classer excel avec deux feuilles.

dans la première feuille, j'ai des cellules avec des ce format : **C3=quesC13** , ** C11=varC8. les C correspondent aux colonnes de la deuxième feuille, C3est la colonne 3 de la feuille 2...
dans la deuxième feuilles, j'ai des données en colonne.

Mon but est de parcourir la feuille 1, s’arrêter dans ce genre de cellule **C3=quesC13**, Vérifier que la cellule C3 = ques (colonne 3 de la feuille 2) , si c'est bon, sur la même ligne récupérer la valeur de la cellule C13 (feuille 2) et la copier à la place de la cellule **C3=quesC13** (feuille 1).

J'ai réussi à extraire la partie texte pour la comparer mais je n'arrive pas à récupérer 3 à part et 13 à part.
J'ai pensé à récupérer les chiffres, mais je n'arrive pas à les dissocier

Num = "*=C0123456789"
texte = Cells.Value

For k = 1 To Len(Cells.Value)
texte = Replace(texte, Mid(Num, k, 1), "")

nombre = IIf(Mid(texte, k, 1) Like "*[0-9]*", nombre & " " & Mid(texte, k, 1), nombre)
Next k
MsgBox texte
MsgBox nombre

Est ce que vous pouvez m'aider?
Bonjour Trappa, bienvenue sur XLD,

Sûrement si vous déposez un fichier (anonymisé), en l'état c'est incompréhensible.

A+

J'ai mis un fichier
 

Pièces jointes

  • EXEMPLE.xlsx
    13.2 KB · Affichages: 34

job75

XLDnaute Barbatruc
Re,

C'est vraiment tiré par les cheveux, pour ne pas dire bordélique.

Mais avec du VBA c'est comestible :
Code:
Function ChercheTruc(t$)
Dim s, col1%, col2%, truc, i&
ChercheTruc = ""
On Error Resume Next
s = Split(t, "**C")
col1 = Val(s(1))
col2 = Val(s(2))
truc = Mid(s(1), InStr(s(1), "=") + 1)
If IsNumeric(truc) Then truc = CDbl(truc)
With Feuil2 'CodeName de la feuille
    i = Application.Match(truc, .Columns(col1), 0)
    ChercheTruc = .Columns(col2).Cells(i)
End With
End Function
Ce code doit impérativement être placé dans un module standard.

La fonction est utilisée dans les cellules jaunes du fichier joint.

A+
 

Pièces jointes

  • EXEMPLE(1).xlsm
    26.1 KB · Affichages: 35

Trappa

XLDnaute Nouveau
Merci pour votre réponse ,
Je n'ai pas bien compris ce que fait le programme, donc je l'ai commenté ligne par ligne. Si vous pouvez me corriger svp? Je n'ai non plus réussi à l'exécuter où plutôt ça ne marche pas!!

J'ai besoin d’appuyer sur un bouton et la recherche et le remplacement se font de cette manière.

Recherche du numéro de bon (dans la feuille 2) qui correspond à celui indiqué dans la 1 er feuille
Une fois le numéro de bon trouvé, il cherche les cellule avec **C, où sous ce format **Cnn1=texte**Cnn2.
Quand il trouve ce type de cellule, il va s’arrêter sur cette dernière.
Il va parcourir les caractère de la cellule comme suit : . **Cii=texte**Cjj.
Puis il va comparer le nombre ii et jj avec les colonnes ii et jj de la feuille 2
Cii correspond à la colonne ii de feuille 2 (qui a le même numéro de bon, mais pas forcément sur la même ligne) qui va être comparé avec le contenu "teste" par exemple
--> **C2=bon**C6) dans la colonne2 (Cii) il va chercher le texte:"bon", il va le trouver dans la 1er ligne,
--> **C11=TITI**C8 dans la colonne 11 Cii) le texte:TiTi correspond à la ligne 12
Cjj correspond à la colonne de la feuille 2 (qui est sur la même ligne que la cellule ii) qui va venir remplacer la cellule sous format **Cii=texte**Cjj.
Exemple
--> **C2=bon**C6 --> Cjj sera dans la colonne 6 sur la ligne 1
--> C11=TITI**C8 __> Cjj correspond à la colonne 8 ligne 12

Merci pour votre aide


Function ChercheTruc()
Dim s, col1%, col2%, truc, i& ' définit comme quoi? integer, variant....
ChercheTruc = "" ' variable vide
On Error Resume Next
s = Split(t, "**C")
col1 = Val(s(1)) 'correspond au premier nombre où colonne 1 de la feuille 2?
col2 = Val(s(2))
truc = Mid(s(1), InStr(s(1), "=") + 1) ' récupérer la chaîne d'après =
If IsNumeric(truc) Then truc = CDbl(truc) ' si c'est numérique ???
With Feuil2 'CodeName de la feuille
i = Application.Match(truc, .Columns(col1), 0) ' chercher la correspondance avec truc
ChercheTruc = .Columns(col2).Cells(i) ' le cherchertruc correspond à à la col et cellule
End With

End Function
 

job75

XLDnaute Barbatruc
Bonjour Trappa,

Avec une feuille pour le résultat voici le code :
Code:
Sub Résultat()
Dim t, ub%, i&, j%
With Feuil3 'CodeName de la feuille Résultat
    .[A:I].Clear 'RAZ
    [A:I].Copy .[A1]
    t = .UsedRange.Resize(.UsedRange.Rows.Count + 1).Formula 'matrice, plus rapide, au moins 2 éléments
    ub = UBound(t, 2)
    For i = 1 To UBound(t) - 1
        For j = 1 To ub
            If Left(t(i, j), 3) = "**C" Then t(i, j) = ChercheTruc(CStr(t(i, j)))
    Next j, i
    .UsedRange = t 'restitution
    .Columns.AutoFit 'ajustement largeur
    .Activate 'facultatif
End With
End Sub

Function ChercheTruc(t$)
Dim s, col1%, col2%, truc, i&
ChercheTruc = ""
On Error Resume Next
s = Split(t, "**C")
col1 = Val(s(1))
col2 = Val(s(2))
truc = Mid(s(1), InStr(s(1), "=") + 1)
If IsNumeric(truc) Then truc = CDbl(truc)
With Feuil2 'CodeName de la feuille
    i = Application.Match(truc, .Columns(col1), 0)
    ChercheTruc = .Columns(col2).Cells(i)
End With
End Function
Fichier (2).

A+
 

Pièces jointes

  • EXEMPLE(2).xlsm
    28.3 KB · Affichages: 31

Trappa

XLDnaute Nouveau
Bonjour Trappa,

Avec une feuille pour le résultat voici le code :
Code:
Sub Résultat()
Dim t, ub%, i&, j%
With Feuil3 'CodeName de la feuille Résultat
    .[A:I].Clear 'RAZ
    [A:I].Copy .[A1]
    t = .UsedRange.Resize(.UsedRange.Rows.Count + 1).Formula 'matrice, plus rapide, au moins 2 éléments
    ub = UBound(t, 2)
    For i = 1 To UBound(t) - 1
        For j = 1 To ub
            If Left(t(i, j), 3) = "**C" Then t(i, j) = ChercheTruc(CStr(t(i, j)))
    Next j, i
    .UsedRange = t 'restitution
    .Columns.AutoFit 'ajustement largeur
    .Activate 'facultatif
End With
End Sub

Function ChercheTruc(t$)
Dim s, col1%, col2%, truc, i&
ChercheTruc = ""
On Error Resume Next
s = Split(t, "**C")
col1 = Val(s(1))
col2 = Val(s(2))
truc = Mid(s(1), InStr(s(1), "=") + 1)
If IsNumeric(truc) Then truc = CDbl(truc)
With Feuil2 'CodeName de la feuille
    i = Application.Match(truc, .Columns(col1), 0)
    ChercheTruc = .Columns(col2).Cells(i)
End With
End Function
Fichier (2).

A+


Merci Job75 pour la rapidité, je viens de tester et ça marche, mais quand j'ai changé le numéro de bon, b151, il me garde les anciennes valeurs
 

Trappa

XLDnaute Nouveau
Sub Résultat()
Dim t, ub%, i&, j% ' t pour initaliser un tableau, ub est un integer pour la longeur du tab, i et j compteur
With Feuil3 'CodeName de la feuille Résultat
.[A:I].Clear 'RAZ 'effacter toute la feuille, qu'est ce que veut dire .[A:I] ????
[A:I].Copy .[A1] ' remplacer la feuille par à partir de A1
t = .UsedRange.Resize(.UsedRange.Rows.Count + 1).Formula 'matrice, plus rapide, au moins 2 éléments
ub = UBound(t, 2) ' retour la longeur du tableau t en 2 dimension ? (ligne et colonne?
For i = 1 To UBound(t) - 1
For j = 1 To ub
If Left(t(i, j), 3) = "**C" Then t(i, j) = ChercheTruc(CStr(t(i, j)))
' si le gauche de la cellune commence par **C donc chercher
' cherche la partie texte ou string

Next j, i
.UsedRange = t 'restitution de quoi ?
.Columns.AutoFit 'ajustement largeur
.Activate 'facultatif
End With
End Sub

Function ChercheTruc(t$)
Dim s, col1%, col2%, truc, i& ' ça veut dire quoi col1% ?
ChercheTruc = ""
On Error Resume Next
s = Split(t, "**C")
col1 = Val(s(1)) ' qu'est ce que je récupère?
col2 = Val(s(2))
truc = Mid(s(1), InStr(s(1), "=") + 1)
If IsNumeric(truc) Then truc = CDbl(truc)
With Feuil2 'CodeName de la feuille
i = Application.Match(truc, .Columns(col1), 0)
ChercheTruc = .Columns(col2).Cells(i)
End With
End Function


si je n'ai pas fait de commentaire, c'est que je n'ai pas compris :/.
 

Discussions similaires