Transformer et adapter INDEX/EQUIV en boucle vba

**Akhlan** · 21/02/2013, 16h21

Merci Daniel,

j'ai encore une incompatibilité de type (erreur 13) mais je ne sais pas l'identifier...

est ce que le signe / pourrait en être la cause ?

Code :

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

 (lvdd) I/O ERROR DETECTED BY LVM

Je cherche de mon côté mais même en virant tous les "=" de mes lignes, ça n'a pas fonctionné chez moi...

Merci en tout cas de m'aider

**Daniel.C** · 21/02/2013, 17h08

Est-ce que tu peux mettre le classeur en PJ ? ou seulement mettre les données sur mon classeur ?

**Akhlan** · 21/02/2013, 18h17

je t'ai envoyé un MP...

sinon j'ai trouvé le champ qui me posait problème... J'ai un ligne qui fait plus de 255 caractères, et c'est elle qui fait planter ton script...

**Daniel.C** · 21/02/2013, 20h47

J'arrête pour ce soir. J'espère que la macro de gFZT82 fonctionne, elle, parce que je suis en plein brouillard...

**Daniel.C** · 21/02/2013, 21h01

Tu veux dire que ça fonctionne, si tu enlèves la ligne ? Je croyais que cette limite était obsolète...

**Akhlan** · 22/02/2013, 05h40

Daniel, notre aventure se termine ^^

J'ai contourné le problème en ne gardant que les 250 premiers caractères des deux lignes qui faisaient planter ton script... 2 petites lignes sur presque 2000, c'est une marge d'erreur tout à fait acceptable ^^

Je vais regarder ça de plus près demain pour transformer cette commande (STXT) en vba en début de ton script si jamais 2 ou 3 autres lignes du même type apparaissaient mais là, il est 05h30 et je n'arrive plus trop à réfléchir et je vais attendre la fin de ma nuit de taf....

**Daniel.C** · 22/02/2013, 10h14

Ça devrait donner ça (j'ai aussi testé les valeurs de la colonne E; si ce n'est pas nécessaire, on peut supprimer la boucle; j'ai aussi limité la longueur des valeurs à 248 pour que 248 + 3 (***) +4 (équipement) ne dépasse pas 255; à la réflexion, ce n'est pas très malin, il vaudrait mieux tester la limite à 255 - 3 - longueur de l'équipement; je vais chercher dans ce sens) :

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
Sub test2()
    Dim Tabl1, Tabl2, Equips, Res() As String, Ctr As Long
    Dim Tabl, Dico As Object 'table double entrée
    Dim ResEquip(), ResOccur() As Long, Plage As Range
    Set Dico = CreateObject("Scripting.Dictionary")
    Ctr = 0
    ReDim Res(3, 1)
    ReDim ResEquip(1)
    ReDim ResOccur(1)
    With Sheets("Feuille_1")
        Tabl1 = Application.Transpose(.Range(.[D2], .Cells(.Rows.Count, 4).End(xlUp)))
        For i = 1 To UBound(Tabl1)
            If Len(Tabl1(i)) > 248 Then Tabl1(i) = Left(Tabl1(i), 248)
        Next i
        Tabl2 = Application.Transpose(.Range(.[E2], .Cells(.Rows.Count, 5).End(xlUp)))
        For i = 1 To UBound(Tabl2)
            If Len(Tabl2(i)) > 248 Then Tabl2(i) = Left(Tabl2(i), 248)
        Next i
        For i = 1 To UBound(Tabl1)
            If Not Dico.exists(Tabl1(i) & "***" & Tabl2(i)) Then
                Dico.Add Tabl1(i) & "***" & Tabl2(i), Tabl1(i) & "***" & Tabl2(i)
            End If
        Next i
        For Each Item In Dico.items
            tablo = Split(Item, "***")
            Ctr = Ctr + 1
            ReDim Preserve Res(3, Ctr)
            Res(1, Ctr) = Item
            Res(2, Ctr) = tablo(1)
            Res(3, Ctr) = tablo(0)
        Next Item
    End With
    With Sheets("Feuille_5")
        .[H:K].ClearContents
        .[H2].Resize(UBound(Res, 2), 3).NumberFormat = "@"
        .[H2].Resize(UBound(Res, 2), 3) = Application.Transpose(Res)
        Set Plage = .Range(.[H2], .Cells(.Rows.Count, 10).End(xlUp))
        Plage.Sort key1:=.[I2], order1:=xlAscending, key2:=.[J2], order2:=xlAscending, Header:=xlNo
        Tabl = Application.Transpose(.Range(.[H2], .Cells(.Rows.Count, 8).End(xlUp)))
        ReDim ResOccur(Dico.Count)
        For i = 1 To UBound(Tabl1)
            Ctr = Application.Match(Tabl1(i) & "***" & Tabl2(i), Tabl, 0)
            ResOccur(Ctr) = ResOccur(Ctr) + 1
        Next
        .[K2].Resize(UBound(ResOccur)) = Application.Transpose(ResOccur)
        .[H:H].ClearContents
        Dim Final()
        ReDim Final(3, 1)
        Ctr = 0
        Tabl = Application.Transpose(.Range(.[I2], .Cells(.Rows.Count, 11).End(xlUp)))
        For i = 1 To UBound(Tabl, 2)
                Ctr = Ctr + 1
                ReDim Preserve Final(3, Ctr)
                Final(1, Ctr) = Tabl(1, i)
                Final(2, Ctr) = Tabl(2, i)
                Final(3, Ctr) = Tabl(3, i)
                If i < UBound(Tabl, 2) Then
                    If Tabl(1, i) <> Tabl(1, i + 1) Then
                        Ctr = Ctr + 1
                        ReDim Preserve Final(3, Ctr)
                    End If
                End If
        Next
        For i = UBound(Final, 2) To 2 Step -1
            If Final(1, i) = Final(1, i - 1) Then Final(1, i) = ""
        Next
        .[H:K].Clear
        .[I2].Resize(UBound(Final, 2), 2).NumberFormat = "@"
        .[I2].Resize(UBound(Final, 2), 3) = Application.Transpose(Final)
        .Columns(10).AutoFit
    End With
End Sub

**Daniel.C** · 22/02/2013, 10h20

Modifié comme indiqué dans le précédent message :

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
Sub test2()
    Dim Tabl1, Tabl2, Equips, Res() As String, Ctr As Long
    Dim Tabl, Dico As Object 'table double entrée
    Dim ResEquip(), ResOccur() As Long, Plage As Range
    Set Dico = CreateObject("Scripting.Dictionary")
    Ctr = 0
    ReDim Res(3, 1)
    ReDim ResEquip(1)
    ReDim ResOccur(1)
    With Sheets("Feuille_1")
        Tabl1 = Application.Transpose(.Range(.[D2], .Cells(.Rows.Count, 4).End(xlUp)))
        Tabl2 = Application.Transpose(.Range(.[E2], .Cells(.Rows.Count, 5).End(xlUp)))
        For i = 1 To UBound(Tabl2)
            If Len(Tabl2(i)) > 248 Then Tabl2(i) = Left(Tabl2(i), 248)
        Next i
        For i = 1 To UBound(Tabl1)
            If Len(Tabl1(i)) > (252 - Len(Tabl2(i))) Then Tabl1(i) = Left(Tabl1(i), 252 - Len(Tabl2(i)))
        Next i
        For i = 1 To UBound(Tabl1)
            If Not Dico.exists(Tabl1(i) & "***" & Tabl2(i)) Then
                Dico.Add Tabl1(i) & "***" & Tabl2(i), Tabl1(i) & "***" & Tabl2(i)
            End If
        Next i
        For Each Item In Dico.items
            tablo = Split(Item, "***")
            Ctr = Ctr + 1
            ReDim Preserve Res(3, Ctr)
            Res(1, Ctr) = Item
            Res(2, Ctr) = tablo(1)
            Res(3, Ctr) = tablo(0)
        Next Item
    End With
    With Sheets("Feuille_5")
        .[H:K].ClearContents
        .[H2].Resize(UBound(Res, 2), 3).NumberFormat = "@"
        .[H2].Resize(UBound(Res, 2), 3) = Application.Transpose(Res)
        Set Plage = .Range(.[H2], .Cells(.Rows.Count, 10).End(xlUp))
        Plage.Sort key1:=.[I2], order1:=xlAscending, key2:=.[J2], order2:=xlAscending, Header:=xlNo
        Tabl = Application.Transpose(.Range(.[H2], .Cells(.Rows.Count, 8).End(xlUp)))
        ReDim ResOccur(Dico.Count)
        For i = 1 To UBound(Tabl1)
            Ctr = Application.Match(Tabl1(i) & "***" & Tabl2(i), Tabl, 0)
            ResOccur(Ctr) = ResOccur(Ctr) + 1
        Next
        .[K2].Resize(UBound(ResOccur)) = Application.Transpose(ResOccur)
        .[H:H].ClearContents
        Dim Final()
        ReDim Final(3, 1)
        Ctr = 0
        Tabl = Application.Transpose(.Range(.[I2], .Cells(.Rows.Count, 11).End(xlUp)))
        For i = 1 To UBound(Tabl, 2)
                Ctr = Ctr + 1
                ReDim Preserve Final(3, Ctr)
                Final(1, Ctr) = Tabl(1, i)
                Final(2, Ctr) = Tabl(2, i)
                Final(3, Ctr) = Tabl(3, i)
                If i < UBound(Tabl, 2) Then
                    If Tabl(1, i) <> Tabl(1, i + 1) Then
                        Ctr = Ctr + 1
                        ReDim Preserve Final(3, Ctr)
                    End If
                End If
        Next
        For i = UBound(Final, 2) To 2 Step -1
            If Final(1, i) = Final(1, i - 1) Then Final(1, i) = ""
        Next
        .[H:K].Clear
        .[I2].Resize(UBound(Final, 2), 2).NumberFormat = "@"
        .[I2].Resize(UBound(Final, 2), 3) = Application.Transpose(Final)
        .Columns(10).AutoFit
    End With
End Sub

**Akhlan** · 24/02/2013, 21h06

Merci Daniel, ça fonctionne parfaitement, si tu veux voir le résultat, j'ai ramené et anonymisé le fichier du boulot...

J'aurais une dernière demande.... Après je ne t'embête plus ^^

Si jamais c'est facile pour toi, il y a t'il moyen d'avoir la colonne "Redondance" entre "Serveurs (I)" et "Alarmes (J)" au lieu de l'avoir à la fin des alarmes comme actuellement ?

Si ça demande de refaire trop de chose, laisse tomber, c'est déjà très bien comme cela

Akhlan

**Daniel.C** · 25/02/2013, 10h57

Bonjour,

Je regarde. Si je ne peux pas le faire ce matin, ça sera pour mon retour en fin d'après-midi.

**Daniel.C** · 25/02/2013, 11h09

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
117
118
119
120
121
122
123
124
125
Option Base 1
'Option Explicit
'---------------------------------------------------------------------------------------------------------------
'Classe les serveurs par nombre d'alarmes
'---------------------------------------------------------------------------------------------------------------
Sub Calcul_Stats()
    DerligServeur = Sheets("Incidents mensuels").Range("F65536").End(xlUp).Row
    Sheets("Stats").Select
    Range("E2:G" & DerligServeur).Select
    Selection.ClearContents
    Range("E2").Select
    ActiveCell.FormulaR1C1 = _
        "=IF('Incidents mensuels'!RC[1]="""",""NA"",'Incidents mensuels'!RC[1])"
    Selection.AutoFill Destination:=Range("E2:E" & DerligServeur), Type:=xlFillDefault
    Range("E2:E" & DerligServeur).Select
    Selection.Copy
    Range("F2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    ActiveSheet.Range("$F$1:$F$" & DerligServeur).RemoveDuplicates Columns:=1, Header:= _
        xlYes
    DerLigServeur2 = Sheets("Stats").Range("F65536").End(xlUp).Row
    Range("G2").Select
    ActiveCell.FormulaR1C1 = "=COUNTIF('Incidents mensuels'!C[-1],RC[-1])"
    Selection.AutoFill Destination:=Range("G2:G" & DerLigServeur2), Type:=xlFillDefault
    Columns("F:G").Select
    ActiveWorkbook.Worksheets("Stats").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Stats").Sort.SortFields.Add Key:=Range("G2:G" & DerLigServeur2) _
        , SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Stats").Sort
        .SetRange Range("F1:G" & DerLigServeur2)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Columns("F:F").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Range("A1").Select
 
'---------------------------------------------------------------------------------------------------------------
'Liste les alarmes par serveur
'---------------------------------------------------------------------------------------------------------------
Dim Tabl1, Tabl2, Equips, Res() As String, Ctr As Long
Dim Tabl, Dico As Object 'table double entrée
Dim ResEquip(), ResOccur() As Long, Plage As Range
Set Dico = CreateObject("Scripting.Dictionary")
Ctr = 0
ReDim Res(3, 1)
ReDim ResEquip(1)
ReDim ResOccur(1)
With Sheets("Incidents mensuels")
Tabl1 = Application.Transpose(.Range(.[D2], .Cells(.Rows.Count, 4).End(xlUp)))
Tabl2 = Application.Transpose(.Range(.[F2], .Cells(.Rows.Count, 6).End(xlUp)))
For i = 1 To UBound(Tabl2)
If Len(Tabl2(i)) > 248 Then Tabl2(i) = Left(Tabl2(i), 248)
Next i
For i = 1 To UBound(Tabl1)
If Len(Tabl1(i)) > (252 - Len(Tabl2(i))) Then Tabl1(i) = Left(Tabl1(i), 252 - Len(Tabl2(i)))
Next i
For i = 1 To UBound(Tabl1)
If Not Dico.exists(Tabl1(i) & "***" & Tabl2(i)) Then
Dico.Add Tabl1(i) & "***" & Tabl2(i), Tabl1(i) & "***" & Tabl2(i)
End If
Next i
For Each Item In Dico.items
tablo = Split(Item, "***")
Ctr = Ctr + 1
ReDim Preserve Res(3, Ctr)
Res(1, Ctr) = Item
Res(2, Ctr) = tablo(1)
Res(3, Ctr) = tablo(0)
Next Item
End With
With Sheets("Stats")
.Range("H2:K65536").ClearContents
.[H2].Resize(UBound(Res, 2), 3).NumberFormat = "@"
.[H2].Resize(UBound(Res, 2), 3) = Application.Transpose(Res)
Set Plage = .Range(.[H2], .Cells(.Rows.Count, 10).End(xlUp))
Plage.Sort key1:=.[I2], order1:=xlAscending, key2:=.[J2], order2:=xlAscending, Header:=xlNo
Tabl = Application.Transpose(.Range(.[H2], .Cells(.Rows.Count, 8).End(xlUp)))
ReDim ResOccur(Dico.Count)
For i = 1 To UBound(Tabl1)
Ctr = Application.Match(Tabl1(i) & "***" & Tabl2(i), Tabl, 0)
ResOccur(Ctr) = ResOccur(Ctr) + 1
Next
.[K2].Resize(UBound(ResOccur)) = Application.Transpose(ResOccur)
.[H:H].ClearContents
Dim Final()
ReDim Final(3, 1)
Ctr = 0
Tabl = Application.Transpose(.Range(.[I2], .Cells(.Rows.Count, 11).End(xlUp)))
For i = 1 To UBound(Tabl, 2)
    Ctr = Ctr + 1
    ReDim Preserve Final(3, Ctr)
    Final(1, Ctr) = Tabl(1, i)
    Final(2, Ctr) = Tabl(2, i)
    Final(3, Ctr) = Tabl(3, i)
    If i < UBound(Tabl, 2) Then
        If Tabl(1, i) <> Tabl(1, i + 1) Then
            Ctr = Ctr + 1
            ReDim Preserve Final(3, Ctr)
        End If
    End If
Next
For i = UBound(Final, 2) To 2 Step -1
If Final(1, i) = Final(1, i - 1) Then Final(1, i) = ""
Next
.Range("H2:K65536").Clear
.[I2].Resize(UBound(Final, 2), 2).NumberFormat = "@"
.[I2].Resize(UBound(Final, 2), 3) = Application.Transpose(Final)
.Columns(10).Cut .[L1]
.Columns(10).Delete
.Columns(11).AutoFit
End With
End Sub

C'est une rustine, mais ça fonctionne (apparemment).

**Akhlan** · 26/02/2013, 11h42

Super Daniel, un grand merci pour ton boulot, je ne pensais pas au début que ça allait être si compliqué (pour moi...) mais le résultat est parfait ;-)

Si tu as manipulé un peu le fichier, tu as pu voir 2 ou 3 autres coquilles, j'ouvre un nouveau post pour ça, si le coeur t'en dit ^^

En tout cas, encore merci ^^

Transformer et adapter INDEX/EQUIV en boucle vba

Macros et VBA Excel

Discussions similaires

Partager

Partager