[VBA - Excel] Élaboration d'une macro
Bonjour.
Bon, concernant la colonne Etat et Datacenter, c'est fait. J'ai réussi
Pour réussir à faire la colonne Etat, j'ai trafiqué un peu les colonnes en mettant toutes les colonnes qu'on modifie les uns à côté des autres.
Quand les colonnes sont éparpillées, je n'y arrive pas.
Je ne dois pas très bien comprendre le fonctionnement du tableau sûrement ...
Voici le code complet :
Sub MiseAJour()
Dim d As Object, Tablo(), pmc, mach, ln%, i%, k%
Set d = CreateObject("Scripting.Dictionary")
d.CompareMode = vbTextCompare
On Error GoTo noclasseur
With Workbooks("WBX - extraction pure.xlsx").Worksheets(1)
On Error GoTo 0
ln = .Cells(.Rows.Count, 10).End(xlUp).Row
If .Cells(ln, 10) Like "Sum*" Then ln = ln - 1
For i = 2 To ln
mach = Trim(.Cells(i, 10)): k = InStr(1, mach, "(")
If k > 0 Then mach = Trim(Left(mach, k - 1))
pmc = .Cells(i, 9) & ";" _
& .Cells(i, 19) & ";" & .Cells(i, 20) & ";" & .Cells(i, 21) & ";" _
& .Cells(i, 23) & ";" & .Cells(i, 24)
d(mach) = pmc
Next i
End With
With ThisWorkbook.Worksheets("Inventaire 060616")
ln = .Cells(.Rows.Count, 3).End(xlUp).Row
ReDim Tablo(3 To ln, 5)
For i = 3 To ln
mach = .Cells(i, 3)
If d.exists(mach) Then
pmc = Split(d(mach), ";")
For k = 0 To 0
Tablo(i, k) = CStr(pmc(k))
Next k
For k = 1 To 3
Tablo(i, k) = CDec(pmc(k))
Next k
For k = 4 To 5
Tablo(i, k) = CStr(pmc(k))
Next k
d.Remove (mach)
End If
Next i
Application.ScreenUpdating = False
With .Range("H3:M" & ln)
.Value = Tablo
.Columns(1).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End With
If d.Count > 0 Then
ln = .Cells(.Rows.Count, 3).End(xlUp).Row
ReDim Tablo(1 To d.Count, 5): i = 0
For Each mach In d.keys
i = i + 1: pmc = Split(d(mach), ";")
.Cells(ln + i, 3) = mach
For k = 0 To 0
Tablo(i, k) = CStr(pmc(k))
Next k
For k = 1 To 3
Tablo(i, k) = CDec(pmc(k))
Next k
For k = 4 To 5
Tablo(i, k) = CStr(pmc(k))
Next k
Next mach
.Range("H" & ln + 1 & ":M" & ln + i).Value = Tablo
End If
End With
iDerLig = Range("C" & Rows.Count).End(xlUp).Row
For iLig = 3 To iDerLig
If InStr(1, Range("C" & iLig).Value, "-REC-") > 0 Then
Range("E" & iLig).Value = "Recette"
ElseIf InStr(1, Range("C" & iLig).Value, "-PP-") > 0 Then
Range("E" & iLig).Value = "Pré-Production"
ElseIf InStr(1, Range("C" & iLig).Value, "-PRD-") > 0 Then
Range("E" & iLig).Value = "Production"
ElseIf InStr(1, Range("C" & iLig).Value, "-prd-") > 0 Then
Range("E" & iLig).Value = "Production"
End If
Next iLig
iDerLig1 = Range("M" & Rows.Count).End(xlUp).Row
For iLig1 = 3 To iDerLig1
If InStr(1, Range("M" & iLig1).Value, "-th3") > 0 Then
Range("A" & iLig1).Value = "TH3"
Else
Range("A" & iLig1).Value = "PAR7"
End If
Next iLig1
Cible = True
iDerLig2 = Range("M" & Rows.Count).End(xlUp).Row
For iLig2 = 3 To iDerLig2
If InStr(Cible, Range("H" & iLig2).Value) > 0 Then
Range("H" & iLig2).Value = "ON"
Range("H" & iLig2).Interior.Color = RGB(146, 208, 80)
Else
Range("H" & iLig2).Value = "OFF"
Range("H" & iLig2).Interior.ColorIndex = 3
End If
Next iLig2
With Range("A:O")
.HorizontalAlignment = xlHAlignCenter
.VerticalAlignment = xlVAlignCenter
End With
Exit Sub
noclasseur:
MsgBox "Classeur d'extraction non trouvé." & Chr(10) & "Vérifier.", vbCritical, "Erreur"
End SubBref, par contre, maintenant, il faut que je fasse la colonne Service Rendu.
Pour la colonne Service Rendu :
- Dans mon fichier d'extraction, la colonne est AM (celulle 39). Son nom est Remarque RED.
- Dans mon fichier original, la colonne est D (cellule 4). Son nom est Service Rendu.
- Ce sont des chaînes de caractères pour les 2 colonnes.
Est-ce possible d'avoir un peu d'aide ? J'aimerai bien garder ma colonne au même endroit cette fois ...
Mais ça, je ne sais vraiment pas comment faire
PS : Voici le fichier original en pièce jointe.
Bonjour.
Je suis toujours bloqué concernant la colonne Service Rendu.
Je me permet donc une petite relance. Pouvez-vous m'aider s'il vous plait ?
Merci et bonne soirée
Bonjour,
A essayer :
Sub MiseAJour()
Dim d As Object, Tablo(), pmc, mach, ln%, i%, k%
Set d = CreateObject("Scripting.Dictionary")
d.CompareMode = vbTextCompare
On Error GoTo noclasseur
With Workbooks("WBX - extraction pure.xlsx").Worksheets(1)
On Error GoTo 0
ln = .Cells(.Rows.Count, 10).End(xlUp).Row
If .Cells(ln, 10) Like "Sum*" Then ln = ln - 1
For i = 2 To ln
mach = Trim(.Cells(i, 10)): k = InStr(1, mach, "(")
If k > 0 Then mach = Trim(Left(mach, k - 1))
pmc = .Cells(i, 19) & ";" & .Cells(i, 20) & ";" & .Cells(i, 21) & ";" _
& .Cells(i, 23) & ";" & .Cells(i, 24)
d(mach) = pmc
Next i
End With
'Workbooks("WBX - extraction pure.xlsx").Close False
With ThisWorkbook.Worksheets("Inventaire 060616")
ln = .Cells(.Rows.Count, 3).End(xlUp).Row
ReDim Tablo(3 To ln, 6)
For i = 3 To ln
mach = .Cells(i, 3)
If d.exists(mach) Then
pmc = Split(d(mach), ";")
For k = 0 To 2
Tablo(i, k) = CDec(pmc(k))
Next k
For k = 3 To 4
Tablo(i, k) = .Cells(i, k + 9)
Tablo(i, k + 2) = pmc(k)
Next k
d.Remove (mach)
End If
Next i
Application.ScreenUpdating = False
With .Range("I3:O" & ln)
.Value = Tablo
.Columns(1).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End With
End With
If d.Count > 0 Then
With Workbooks("WBX - extraction pure.xlsx").Worksheets(1)
ln = .Cells(.Rows.Count, 10).End(xlUp).Row
For Each mach In d.keys
For i = 2 To ln
If .Cells(i, 10) Like "*" & mach & "*" Then
pmc = .Cells(i, 7) & ";" & IIf(.Cells(i, 9) = "true", "ON", "OFF") & ";"
pmc = pmc & d(mach): d(mach) = pmc: Exit For
End If
Next i
Next mach
End With
With ThisWorkbook.Worksheets("Inventaire 060616")
ln = .Cells(.Rows.Count, 3).End(xlUp).Row
ReDim Tablo(1 To d.Count, 7): i = 0
For Each mach In d.keys
i = i + 1: pmc = Split(d(mach), ";")
.Cells(ln + i, 3) = mach
.Cells(ln + i, 1) = pmc(0)
Tablo(i, 0) = pmc(1)
For k = 2 To 4
Tablo(i, k - 1) = CDec(pmc(k))
Next k
For k = 5 To 6
Tablo(i, k + 1) = pmc(k)
Next k
Next mach
.Range("H" & ln + 1 & ":O" & ln + i).Value = Tablo
End If
End With
Workbooks("WBX - extraction pure.xlsx").Close False
Exit Sub
noclasseur:
MsgBox "Classeur d'extraction non trouvé." & Chr(10) & "Vérifier.", vbCritical, "Erreur"
End SubLa première partie est inchangée, sauf qu'on ne ferme plus le classeur Extraction pure (ligne invalidée)
La seconde partie commence à : If d.Count > 0 Then
On retourne dans le classeur Extraction pure :
pour chaque élément dico (machine) on la recherche et on complète avec les données DataCenter et Etat qu'on ajoute devant les données antérieurement recueillies.
Chaque élément dico contient une chaîne concaténant les contenus destinées dans le classeur cible aux colonnes (dans cet ordre) :
A H I J K N O
L'affectation des ajouts se fait dans les mêmes conditions que précédemment mais : Tablo est redimensionné sur 8 colonnes (0 à 7) pour couvrir une plage H:O, la machine est affectée en J comme précédemment mais le DataCenter est affecté simultanément en A (élément 0 du tableau de données de l'élément dico) ; les élément 1 à 6 dudit tableau de données vont garnir le Tablo : 1 à 4 vers éléments colonne 0 à 3 du Tablo, 5 et 6 vers él. col. 6 et 7 du Tablo.
Cordialement.
Bonjour.
Merci beaucoup pour ce code.
Je vais colorer en jaune l'erreur :
Sub MiseAJour()
Dim d As Object, Tablo(), pmc, mach, ln%, i%, k%
Set d = CreateObject("Scripting.Dictionary")
d.CompareMode = vbTextCompare
On Error GoTo noclasseur
With Workbooks("WBX - extraction pure.xlsx").Worksheets(1)
On Error GoTo 0
ln = .Cells(.Rows.Count, 10).End(xlUp).Row
If .Cells(ln, 10) Like "Sum*" Then ln = ln - 1
For i = 2 To ln
mach = Trim(.Cells(i, 10)): k = InStr(1, mach, "(")
If k > 0 Then mach = Trim(Left(mach, k - 1))
pmc = .Cells(i, 19) & ";" & .Cells(i, 20) & ";" & .Cells(i, 21) & ";" _
& .Cells(i, 23) & ";" & .Cells(i, 24)
d(mach) = pmc
Next i
End With
'Workbooks("WBX - extraction pure.xlsx").Close False
With ThisWorkbook.Worksheets("Inventaire 060616")
ln = .Cells(.Rows.Count, 3).End(xlUp).Row
ReDim Tablo(3 To ln, 6)
For i = 3 To ln
mach = .Cells(i, 3)
If d.exists(mach) Then
pmc = Split(d(mach), ";")
For k = 0 To 2
Tablo(i, k) = CDec(pmc(k))
Next k
For k = 3 To 4
Tablo(i, k) = .Cells(i, k + 9)
Tablo(i, k + 2) = pmc(k)
Next k
d.Remove (mach)
End If
Next i
Application.ScreenUpdating = False
With .Range("I3:O" & ln)
.Value = Tablo
.Columns(1).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End With
End With
If d.Count > 0 Then
With Workbooks("WBX - extraction pure.xlsx").Worksheets(1)
ln = .Cells(.Rows.Count, 10).End(xlUp).Row
For Each mach In d.keys
For i = 2 To ln
If .Cells(i, 10) Like "*" & mach & "*" Then
pmc = .Cells(i, 7) & ";" & IIf(.Cells(i, 9) = "true", "ON", "OFF") & ";"
pmc = pmc & d(mach): d(mach) = pmc: Exit For
End If
Next i
Next mach
End With
With ThisWorkbook.Worksheets("Inventaire 060616")
ln = .Cells(.Rows.Count, 3).End(xlUp).Row
ReDim Tablo(1 To d.Count, 7): i = 0
For Each mach In d.keys
i = i + 1: pmc = Split(d(mach), ";")
.Cells(ln + i, 3) = mach
.Cells(ln + i, 1) = pmc(0)
Tablo(i, 0) = pmc(1)
For k = 2 To 4
Tablo(i, k - 1) = CDec(pmc(k))
Next k
For k = 5 To 6
Tablo(i, k + 1) = pmc(k)
Next k
Next mach
.Range("H" & ln + 1 & ":O" & ln + i).Value = Tablo
[color=#FFFF00]End If[/color]
End With
Workbooks("WBX - extraction pure.xlsx").Close False
Exit Sub
noclasseur:
MsgBox "Classeur d'extraction non trouvé." & Chr(10) & "Vérifier.", vbCritical, "Erreur"
End SubSinon, si je comprend bien le code. La colonne Service Rendu ne se fait pas dans ce code ? Non ?
Merci
Cordialement.
Bonjour,
Comme je ne suis pas en mesure de tester le code que je te fournis, tu devrais pouvoir déboguer les erreurs simples comme celle-ci !
Quand VBA te met ce type d'erreur, il y a à peu près 1/3 de chances que son indication d e l'élément manquant soit exacte et 2/3 que ce soit un autre élément qui manque, ou bien qui est en trop, ou bien qui ne soit pas à sa place. Ce qui est sûr c'est que quelque chose ne va pas dans le cadrage des blocs d'instruction.
C'est là que l'indentation montre l'un de ses intérêts et pas le moindre !
... Et tu arrives sur un... With ! Cela a pris 2 secondes et tu sais que ça ne va pas là ! Il te faut donc maintenant retrouver le End With correspondant à With. Justement sous ton End If de départ, il y a un End With sur l'alignement précédent : et là en laissant remonter ton regard de la même façon tu tombes direct sur le If de If d.Count > 0 Then ! Ce qui bien sûr ne convient pas non plus.
Donc en environ 5 secondes, tu as détecté qu'un bloc If semble se terminer par End With, et qu'un bloc With inclus dans le précédent semble se terminer par End If ! Probabilité : les deux fins de blocs ont été inversées.
Tu remplaces donc le End If déclencheur de l'erreur par End With, et le End With de la ligne suivante par End If. Tu prends encore quelques secondes pour vérifier que les blocs ont l'air conformes et tu retestes : si cette erreur ne se reproduit plus, c'est OK, sinon tu reprends l'examen un peu plus approfondi des blocs...
Cordialement.
edit : Jamais entendu parler de colonne Service rendu !?
Bonjour.
Si, j'avais bien parlé de la colonne Service Rendu dans mon poste du 9 janvier :
Kivabien a écrit :Pour la colonne Service Rendu :
- Dans mon fichier d'extraction, la colonne est AM (celulle 39). Son nom est Remarque RED.
- Dans mon fichier original, la colonne est D (cellule 4). Son nom est Service Rendu.
- Ce sont des chaînes de caractères pour les 2 colonnes.
Est-ce possible d'avoir un peu d'aide ? J'aimerai bien garder ma colonne au même endroit cette fois ...
Mais ça, je ne sais vraiment pas comment faire
Sinon, merci pour toute les explications. Le code fonctionne très bien. Merci
Cordialement.
Et ensuite ce sera quelle colonne ?
Ta méthode de travail est un peu trop hâchée à mon goût !
Tu devrais faire un point définitif. Définitif, cela veut dire que tout a été envisagé et qu'on n'y revient plus...
MFerrand a écrit :Et ensuite ce sera quelle colonne ?
Ta méthode de travail est un peu trop hâchée à mon goût !
Tu devrais faire un point définitif. Définitif, cela veut dire que tout a été envisagé et qu'on n'y revient plus...
Je suis vraiment désolé.
Mais, pour le coup, c'est bien la dernière colonne car pour les autres colonnes, nous pouvons vraiment pas les faire du moins pas pour le moment.
Kivabien a écrit :MFerrand a écrit :Et ensuite ce sera quelle colonne ?
Ta méthode de travail est un peu trop hâchée à mon goût !
Tu devrais faire un point définitif. Définitif, cela veut dire que tout a été envisagé et qu'on n'y revient plus...
Je suis vraiment désolé.
Mais, pour le coup, c'est bien la dernière colonne car pour les autres colonnes, nous pouvons vraiment pas les faire du moins pas pour le moment.
Pour le code, j'ai remarqué que si un jour l'état de la machine change, la modification ne se fera pas ce qui est un peu problématique.
Enfin de compte, d'après ce que je vois, elle ajoute un simple ON/OFF pour les nouvelles machines ?
Donc, par exemple, si le mois prochain mon extraction dit que la machine "MAC-TEMPLATE" est ON, elle ne le changera pas et restera en OFF ...
Sinon, je peux faire un récapitulatif de ce qu'il reste à faire pour éviter la perte de temps et qu'on clôture définitivement cette demande ?
Pour le code, j'ai remarqué que si un jour l'état de la machine change, la modification ne se fera pas ce qui est un peu problématique.
Enfin de compte, d'après ce que je vois, elle ajoute un simple ON/OFF pour les nouvelles machines ?
Donc, par exemple, si le mois prochain mon extraction dit que la machine "MAC-TEMPLATE" est ON, elle ne le changera pas et restera en OFF ...
Cela, pose bien un problème d'analyse préalable. !
Ensuite des champs invariants qui se correspondent, et qui doivent donc être récupérés lors d'ajouts.
A partir de là on peut définir une bonne fois le "véhicule de déménagement", si je puis me permettre l'analogie...
Cordialement.