Discussion :

[vandman]

Bonjour,

J'ai le code suivant qui est un peu lent a s'exécuter.

L'idée du code est de pouvoir récupérer le poid pour ensuite faire des calcules dans d'autre cellule.
Le seul hic est que j'ai tout un tas d'exception (Pas de poids...) pour chaque exeption, je dois mettre une valeur de poids. J'avais commecer avec un tableau, mais la saisi est vraiment peinible.
Pensez-vous qu'il y aurait une moyen plus simple pour la saisi et pour supprimer le "Select Case"?

Voici le code:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
Function calcKg(Cell As Object)
    Dim RegEx, RegEx_pkg, RegEx_exception, REMatches, REMatches_exception As Object
    Set RegEx = CreateObject("vbscript.regexp")
    Set RegEx_pkg = CreateObject("vbscript.regexp")
    Set RegEx_exception = CreateObject("vbscript.regexp")
    Dim unit, expt As String
    Dim value, pkg, exception(), item As Variant
 
    ReDim exception(15)
    exception(0) = "[^0-9]*(으뜸김240봉).*"
    exception(1) = "[^0-9]*(덴티메이트칫솔 [5+]{3}입).*"
    exception(2) = ".*(대륙식품 도시락김 240개).*"
    exception(3) = ".*(동원 반코팅 장갑 1호).*"
    exception(4) = ".*(맥선 유기농밀가루 강력분20k).*"
    exception(5) = "(맥스웰하우스 커피믹스 마일드).*"
    exception(6) = ".*(맥심 모카골드 마일드 -220T).*"
    exception(7) = ".*(면장갑 초록테 -10켤레).*"
    exception(8) = ".*(센스플러스 크린롤팩25cmx35cm 500매).*"
    exception(9) = ".*(스포롱 클리너 수세미).*"
    exception(10) = ".*(에코미 물티슈 400매).*"
    exception(11) = "(이츠웰 랩 40cmx500m).*"
    exception(12) = "(청정원 위생 크린백).*"
    exception(13) = "(14온즈 무지 아이스컵).*"
    exception(14) = "(큐원 갈색설탕).*"
    exception(15) = "(크린랩 크린장갑200매).*"
 
    With RegEx
        .Global = True
        .MultiLine = True
        .IgnoreCase = True
        .Pattern = "[^0-9]*([0-9.]{1,4}(kg|g|ml|l)).*"
    End With
 
    With RegEx_pkg
        .Global = True
        .MultiLine = True
        .IgnoreCase = True
        .Pattern = "[^0-9]*([^(][0-9]{1,4}(입)[^)]).*"
    End With
 
    Set REMatches = RegEx_pkg.Execute(Cell.value)
    If REMatches.Count > 0 Then
        pkg = CVar(Replace(REMatches(0).SubMatches(0), REMatches(0).SubMatches(1), ""))
    Else:
        pkg = 1
    End If
 
    Set REMatches = RegEx.Execute(Cell.value)
    If REMatches.Count > 0 Then
        unit = REMatches(0).SubMatches(1)
        value = CVar(Replace(REMatches(0).SubMatches(0), unit, ""))
 
        Select Case unit    ' Evaluate unit.
        Case "kg", "Kg", "KG"
            calcKg = value * pkg
        Case "g", "G"
            calcKg = (value / 1000) * pkg
        Case "ml", "mL"
        ' 1L => 1.65Kg'
            calcKg = (value / 1000) * 1.65 * pkg
        Case "l", "L"
            calcKg = value * 1.65 * pkg
        Case Else    ' Other values.
            calcKg = "Not matched"
        End Select
    Else:
        For Each item In exception
            With RegEx_exception
                .Global = True
                .MultiLine = True
                .IgnoreCase = True
                .Pattern = item
            End With
            Set REMatches_exception = RegEx_exception.Execute(Cell.value)
            If REMatches_exception.Count > 0 Then
                expt = REMatches_exception(0).SubMatches(0)
                Select Case expt    ' Evaluate expt.
                Case "덴티메이트칫솔 5+5입"
                    calcKg = expt
                Case "으뜸김240봉"
                    calcKg = expt
                Case "대륙식품 도시락김 240개"
                    calcKg = expt
                Case "동원 반코팅 장갑 1호"
                    calcKg = expt
                Case "맥선 유기농밀가루 강력분20k"
                    calcKg = 20 / 1
                Case "맥스웰하우스 커피믹스 마일드"
                    calcKg = expt
                Case "맥심 모카골드 마일드 -220T"
                    calcKg = expt
                Case "면장갑 초록테 -10켤레"
                    calcKg = expt
                Case "센스플러스 크린롤팩25cmx35cm 500매"
                    calcKg = expt
                Case "스포롱 클리너 수세미"
                    calcKg = expt
                Case "에코미 물티슈 400매"
                    calcKg = expt
                Case "이츠웰 랩 40cmx500m"
                    calcKg = expt
                Case "청정원 위생 크린백"
                    calcKg = expt
                Case "14온즈 무지 아이스컵"
                    calcKg = expt
                Case "큐원 갈색설탕"
                    calcKg = expt
                Case "크린랩 크린장갑200매"
                    calcKg = expt
                Case Else
                     calcKg = "Not matched"
                End Select
            End If
        Next item
    End If
End Function

[jurassic pork]

Hello,
peux-tu nous mettre un exemple où il y a un mix entre des données correctes et des données faisant partie de quelques exceptions en indiquant ce que tu veux récupérer sur celles qui donnent des exceptions.
Ami calmant, J.P

[Jean-Philippe André]

Bonjour,

lorsque le nombre de cas est très élevé, tu peux stocker les valeurs dans une plage de cellules et faire un parcours dessus à la place

[vandman]

Bonjour,

Je précise ma demande:

Sur le millier de référence que nous vendons, environ 10% sont particuliers dans le sens ou le poids renseigner est faut ou non présent (très majoritairement non présent). Le reste des cas se fait en lisant le poids dans la cellule, c'est fait pour cette partie.
Je pars donc sur un traitement double.

Je pense commencer par la gestion des cas générique puis faire une passe avec les cas spécifiques.

Pour les cas spécifiques, je ne fais que chercher du texte, de temps en temps, je mets des regex dans le texte cherché pour prendre des variantes du libellé d'un même produit vendu sur des stores différents.
L'idée derrière les cas spécifique est d'éviter de faire une double boucle if, une boucle pour chercher les regex et une autre pour appliquer la règle, c'est pas performant.

je sais qu'on peut utiliser des array à double dimension et ce serait parfait, mais le mode de saisi des cas spécifiques n'est pas lisible et friendly. Il me faudrait un truc du style

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

exception(0)=  array("Text à chercher", "poid")

plutôt que ça:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
exception(0,0) = "Text à chercher"
exception(0,1) = "poid"

Cordialement,
Pierre

[vandman]

Bonjour,

En fait, la déclaration suivante fonctionne:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
Redim exception(0)
exception(0)=  array("Text à chercher", "poid")

Donc tout vas bien.

Merci à vous d'avoir prix du temps.
Pierre

[jurassic pork]

Hello,
ce que tu peux faire aussi pour optimiser ton code c'est qu'au lieu de faire systématiquement des Regex pour trouver les exceptions, tu fasses un pré-contrôle en cherchant si la valeur lue contient une chaîne d'exception avec une fonction comme celle-ci qui renvoie l'index de la chaîne dans la table des exceptions :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
Function CheckExcept(ArrStrExcept, Value) As Integer
    Dim i as Integer
    CheckExcept = -1
    For i = LBound(ArrStrExcept) To UBound(ArrStrExcept)
      If InStr(Value, ArrStrExcept(i)) Then
         CheckExcept = i
         Exit Function
      End If
    Next
End Function

Les Chaînes d'Exception et les Regex d'Exception se trouvent dans les cellules d'une feuille qui se nomme Exceptions :




Elles sont transformées au début de la macro en tableau comme ceci (le RegEx_Exception est aussi initialisé au début de la macro) :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
    Dim ArrStrExcept, ArrRegexExcept As Variant
    Dim NumExcept As Integer
    ArrRegexExcept = Application.Transpose(Sheets("Exceptions").Range("A1:A16"))
    ArrStrExcept = Application.Transpose(Sheets("Exceptions").Range("B1:B16"))
    Set RegEx_exception = CreateObject("vbscript.regexp")
       With RegEx_exception
                .Global = True
                .MultiLine = True
                .IgnoreCase = True
       End With

Voici comment peut alors devenir le traitement des exceptions dans ta macro

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
    Else:
      NumExcept = CheckExcept(ArrStrExcept, Cell.Value)
      If NumExcept > -1 Then
         PrintUTF8.Append ("Exception " & CStr(NumExcept) & " : " & Cell.Value)
         RegEx_exception.Pattern = ArrRegexExcept(NumExcept)
            Set REMatches_exception = RegEx_exception.Execute(Cell.Value)
            If REMatches_exception.Count > 0 Then
                expt = REMatches_exception(0).SubMatches(0)
                Select Case NumExcept    ' Evaluate
                 Case 1, 2, 3, 4, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16:
                   calcKg = expt
                 Case 5:
                   calcKg = 20 / 1
                 Case Else
                     calcKg = "Not matched"
                End Select
                PrintUTF8.Append ("calcKg : " & calcKg)
             End If
        End If
    End If

Le PrintUTF8.Append remplace le Debug.Print car sinon avec les caractères coréens en a des ?? en affichage dans la fenêtre d'exécution de VBA.
En effet, on ne peut pas afficher correctement des chaînes UTF8 avec le Debug.Print (à moins de changer la langue d'affichage dans Windows ). J'ai trouvé une astuce pour afficher de l'UTF8 :
1 - Créer une UserForm avec un TextBox dedans et un bouton Clear :






2 - Mettre ce code pour la UserForm :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
Private Sub Clear_Click()
Me.TextBox1.Value = ""
End Sub
Public Sub Append(Text)
Me.TextBox1.Value = Me.TextBox1.Value + Text + vbCrLf
End Sub

Au début de la macro, Afficher la UserForm en mode non modal :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

PrintUTF8.Show 0

Et voilà vous pouvez alors visualiser dedans des chaînes UTF8 en utilisant la procédure Append de la Userform dans votre macro :






Ami calmant, J.P