У меня проблема с моим шаблоном в Excel VBA: я хочу работать с конкретным шаблоном c, но если другой шаблон выглядит немного, он также используется - PullRequest
0 голосов
/ 15 апреля 2020

У меня есть две таблицы. Когда я нажимаю на кнопку, я заполняю второй массив значениями первого массива. Вот мой первый массив:

array1

Вот результат второго массива после нажатия:

array2

Мне бы хотелось, чтобы для восстановления информации использовались только шаблоны с [A / ...] [B / ...] и [C / ...]. Однако здесь используются даже шаблоны [...].

Это результат, который мне нужен:

array3

И это мой код:

Sub groupByTypo2()
    Dim rng As Range, c As Range, dict, v, vv, vvv, k, e As Range
    Dim rng2 As Range
    Dim rng3 As Range
    Dim somTot As Variant

    Set dict = CreateObject("scripting.dictionary")
    Set dict2 = CreateObject("scripting.dictionary")

    Set dictFonctionnel = CreateObject("scripting.dictionary")
    Set dictTechnique = CreateObject("scripting.dictionary")
    Set dictSecurite = CreateObject("scripting.dictionary")
    Set dictReglementaire = CreateObject("scripting.dictionary")
    Set dictPartenaire = CreateObject("scripting.dictionary")

    Dim var As Variant


    Dim MiMatriz As Variant
    Dim j As Long
    Dim ZZ As Long
    MiMatriz = Range("A1", Range("A1").End(xlDown)).Value

    Dim Tableau() As String
    Dim I As Integer

    'get the input range for the labels
    With ActiveSheet
        Set rng = .Range(.Range("C1"), .Cells(.Rows.Count, 3).End(xlUp))
        Set rng2 = .Range(.Range("A1"), .Cells(.Rows.Count, 1).End(xlUp))
        Set rng3 = .Range(.Range("B1"), .Cells(.Rows.Count, 2).End(xlUp))
    End With

    For Each c In rng.Cells
        v = Trim(c.Value)
        If InStr(v, "BPTF") > 0 Then
            'vv = Trim(Replace(Replace(Filter(Split(x, ","), "[")(0), "[", ""), "]", ""))
            vv = Trim(Replace(Replace(Join(Filter(Split(v, ","), "["), ","), "[", ""), "]", ""))
            Debug.Print "ETIQUETTE " & vv
            'if there's a label, add to the count
            If Len(vv) > 0 Then dict(vv) = dict(vv) + c.Offset(0, -1).Value
            If Len(vv) > 0 Then dict2(vv) = dict2(vv) + c.Offset(0, -2).Value
        End If

    Next c

    For j = 1 To UBound(MiMatriz) Step 1

        If InStr(Range("C" & j).Value, "BPTF") > 0 Then
            vvv = Trim(Replace(Replace(Join(Filter(Split(Range("C" & j).Value, ","), "["), ","), "[", ""), "]", ""))
            Debug.Print "ETIQUETTTTTTTTTTTTTTTE " & vvv
            If vvv = "Fonctionnel" Then
                For ZZ = 1 To 3 Step 1
                    If Mid("[" & Trim(Split(Split(MiMatriz(j, 1), "[")(ZZ), "]")(0)) & "]", 2, 1) = "A" Then
                        dictFonctionnel("A") = dictFonctionnel("A") + Mid(Trim(Split(Split(MiMatriz(j, 1), "[")(ZZ), "]")(0)), 3) & Chr(10)
                    ElseIf Mid("[" & Trim(Split(Split(MiMatriz(j, 1), "[")(ZZ), "]")(0)) & "]", 2, 1) = "B" Then
                        dictFonctionnel("B") = dictFonctionnel("B") + Mid(Trim(Split(Split(MiMatriz(j, 1), "[")(ZZ), "]")(0)), 3) & Chr(10)
                    ElseIf Mid("[" & Trim(Split(Split(MiMatriz(j, 1), "[")(ZZ), "]")(0)) & "]", 2, 1) = "C" Then
                        dictFonctionnel("C") = dictFonctionnel("C") + Mid(Trim(Split(Split(MiMatriz(j, 1), "[")(ZZ), "]")(0)), 3) & Chr(10)
                    End If
                Next ZZ
            ElseIf vvv = "Technique" Then
                For ZZ = 1 To 3 Step 1
                    If Mid("[" & Trim(Split(Split(MiMatriz(j, 1), "[")(ZZ), "]")(0)) & "]", 2, 1) = "A" Then
                        dictTechnique("A") = dictTechnique("A") + Mid(Trim(Split(Split(MiMatriz(j, 1), "[")(ZZ), "]")(0)), 3) & Chr(10)
                    ElseIf Mid("[" & Trim(Split(Split(MiMatriz(j, 1), "[")(ZZ), "]")(0)) & "]", 2, 1) = "B" Then
                        dictTechnique("B") = dictTechnique("B") + Mid(Trim(Split(Split(MiMatriz(j, 1), "[")(ZZ), "]")(0)), 3) & Chr(10)
                    ElseIf Mid("[" & Trim(Split(Split(MiMatriz(j, 1), "[")(ZZ), "]")(0)) & "]", 2, 1) = "C" Then
                        dictTechnique("C") = dictTechnique("C") + Mid(Trim(Split(Split(MiMatriz(j, 1), "[")(ZZ), "]")(0)), 3) & Chr(10)
                    End If
                Next ZZ
            ElseIf vvv = "Securite" Then
                For ZZ = 1 To 3 Step 1
                    If Mid("[" & Trim(Split(Split(MiMatriz(j, 1), "[")(ZZ), "]")(0)) & "]", 2, 1) = "A" Then
                        dictSecurite("A") = dictSecurite("A") + Mid(Trim(Split(Split(MiMatriz(j, 1), "[")(ZZ), "]")(0)), 3) & Chr(10)
                    ElseIf Mid("[" & Trim(Split(Split(MiMatriz(j, 1), "[")(ZZ), "]")(0)) & "]", 2, 1) = "B" Then
                        dictSecurite("B") = dictSecurite("B") + Mid(Trim(Split(Split(MiMatriz(j, 1), "[")(ZZ), "]")(0)), 3) & Chr(10)
                    ElseIf Mid("[" & Trim(Split(Split(MiMatriz(j, 1), "[")(ZZ), "]")(0)) & "]", 2, 1) = "C" Then
                        dictSecurite("C") = dictSecurite("C") + Mid(Trim(Split(Split(MiMatriz(j, 1), "[")(ZZ), "]")(0)), 3) & Chr(10)
                    End If
                Next ZZ
            End If
       End If

    Next j

    Debug.Print Chr(13) & Chr(10)
    'output the counts
    Debug.Print "Dico 1"
    For Each k In dict
        Debug.Print "Sum for '" & k & "' is " & dict(k)
    Next k



    If dict("Fonctionnel") <> "" Then
        Debug.Print "affiche cle test si elle existe fonctionnel : " & dict("Fonctionnel")
        Range("K7").Value = dict("Fonctionnel")
        Range("M7").Value = dictFonctionnel("A")
        Range("N7").Value = dictFonctionnel("B")
        Range("O7").Value = dictFonctionnel("C")
    End If
    If dict("Technique") <> "" Then
        Debug.Print "affiche cle test si elle existe technique : " & dict("Technique")
        Range("K6").Value = dict("Technique")
        Range("M6").Value = dictTechnique("A")
        Range("N6").Value = dictTechnique("B")
        Range("O6").Value = dictTechnique("C")
    End If
    If dict("Securite") <> "" Then
        Debug.Print "affiche cle test si elle existe securite : " & dict("Securite")
        Range("K8").Value = dict("Securite")
        Range("M8").Value = dictSecurite("A")
        Range("N8").Value = dictSecurite("B")
        Range("O8").Value = dictSecurite("C")
    End If
    If dict("Reglementaire") <> "" Then
        Debug.Print "affiche cle test si elle existe reglementaire : " & dict("Reglementaire")
        Range("K9").Value = dict("Reglementaire")
        Range("M9").Value = dictReglementaire("A")
        Range("N9").Value = dictReglementaire("B")
        Range("O9").Value = dictReglementaire("C")
    End If
    If dict("Partenaire") <> "" Then
        Debug.Print "affiche cle test si elle existe partenaire : " & dict("Partenaire")
        Range("K10").Value = dict("Partenaire")
        Range("M10").Value = dictPartenaire("A")
        Range("N10").Value = dictPartenaire("B")
        Range("O10").Value = dictPartenaire("C")
    End If

    For Each c In rng3.Cells
        somTot = somTot + c

    Next c

    Range("S5").Value = somTot

End Sub

Спасибо за помощь!

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...