VBA - RerchercheV & H combiné
Bonjour,
Je bloque sur une formule je pense. J'ai un classeur avec trois feuilles, soit "Table", "Item", "Planning".
Dans la feuille Planning je voudrais faire une synthèse de toutes les heures de prévu selon 3 critères, soit chercher le jour par rapport au tableau du planning, de vérifier si l'item est valide dans la feuille "Item" et de chercher si c'est le cas dans la "Table" le nombre associé et faire le résultat de tout ça dans la feuille Planning.
Je vous laisse le fichier qui sera plus clair.
En vous remerciant pour votre aide,
Bruno
Bonjour nunos.
Une première solution.
Bonjour thebenoit59 ,
Merci de ton aide c'est nickel. tu sais si il est possible de limité la recherche de date.
J'ai remarqué que si on avait d'autre date plus loin, il collé le résultat au dernier tableau de date.
Je suppose que c'est la recherche qui donne la limite:
With sh3
i = .Cells.Find("*", , , , xlByRows, xlPrevious).Row
j = .Cells.Find("*", , , , xlByColumns, xlPrevious).Column
End WithJ'ai essayé le range mais il passe pas.
Dans mon cas, la tableau de la feuille planning reste invariable, et il sera toujours compris entre A1 et I11, et celui-ci est localisé à partir de AT dans mon fichier.
Encore merci de ton aide.
Je ne comprends pas de quel tableau tu parles.
Peux-tu fournir un exemple concret ?
Désolé, en fait pour faire simple, j'ai plusieurs tableaux dans la feuille "Planning", je voudrais que la macro agisse uniquement sur le tableau qui commence à la colonne K.
Je te joins le fichier modifier.
Merci encore de ton aide
Tu peux remplacer le code par celui-ci :
Option Explicit
Sub consolidation()
Dim sh1 As Worksheet, sh2 As Worksheet, sh3 As Worksheet
Dim t1(1 To 11, 1 To 9), t2()
Dim d As Object, dD As Object
Dim i&, i1 As Byte, j&, j1&
With ThisWorkbook
Set sh1 = .Sheets("Table")
Set sh2 = .Sheets("ITEM")
Set sh3 = .Sheets("Planning")
End With
Set dD = CreateObject("Scripting.Dictionary")
For j = 2 To 9
t1(1, j) = sh3.Cells(1, 10 + j).Value
dD(sh3.Cells(1, j).Value) = j
Next j
For i = LBound(t1) To UBound(t1)
t1(i, 1) = sh3.Cells(i, 11).Value
Next i
Set d = CreateObject("Scripting.Dictionary")
With sh2
i = 2
Do While .Cells(i, "A").Value <> ""
If .Cells(i, "B").Value = "OK" Then d("ITEM " & .Cells(i, "A").Value) = ""
i = i + 1
Loop
End With
t2 = sh1.[a1].CurrentRegion.Value
For i = LBound(t2) To UBound(t2) Step 11
If d.Exists(t2(i, 1)) Then
For j = LBound(t2, 2) + 1 To UBound(t2, 2)
If dD.Exists(t2(i, j)) Then
j1 = dD(t2(i, j))
For i1 = 1 To 10
t1(i1 + 1, j1) = t1(i1 + 1, j1) + t2(i + i1, j)
Next i1
End If
Next j
End If
Next i
sh3.[k1].Resize(UBound(t1), UBound(t1, 2)).Formula = t1
End SubMerci beaucoup thebenoit59 ça marche parfaitement
Petite dernière modification, j'ai du mal a étendre à 15 colonnes, j'ai un bug de calcul je crois ...
Aucune erreur de calcul, mais des erreurs dans les modifications.
Option Explicit
Sub test()
Dim sh1 As Worksheet, sh2 As Worksheet, sh3 As Worksheet
Dim t1(1 To 11, 1 To 15), t2()
Dim d As Object, dD As Object
Dim i&, i1 As Byte, j&, j1&
Dim SCOPE As Range
'--------------------------------------------------------------------------------------------------------------------------
'Clear content
'--------------------------------------------------------------------------------------------------------------------------
Sheets("Matrice").Range("AT:BH").Clear
'--------------------------------------------------------------------------------------------------------------------------
'Initialization TAB
'--------------------------------------------------------------------------------------------------------------------------
Sheets("Matrice").Range("AT1").Value = "PRODUCTION TIME"
Sheets("Matrice").Range("AT2").Value = "Worker Meca"
Sheets("Matrice").Range("AT3").Value = "Meca times"
Sheets("Matrice").Range("AT4").Value = "Worker Elec"
Sheets("Matrice").Range("AT5").Value = "Elec times"
Sheets("Matrice").Range("AT6").Value = "Worker Paint"
Sheets("Matrice").Range("AT7").Value = "Paint times"
Sheets("Matrice").Range("AT8").Value = "Worker Deco"
Sheets("Matrice").Range("AT9").Value = "Deco times"
Sheets("Matrice").Range("AT10").Value = "Counter-Top"
Sheets("Matrice").Range("AT11").Value = "CT times"
Sheets("Matrice").Range("AU1").Value = "=TODAY()"
Sheets("Matrice").Range("AV1").Value = "=TODAY()+1"
Sheets("Matrice").Range("AW1").Value = "=TODAY()+2"
Sheets("Matrice").Range("AX1").Value = "=TODAY()+3"
Sheets("Matrice").Range("AY1").Value = "=TODAY()+4"
Sheets("Matrice").Range("AZ1").Value = "=TODAY()+5"
Sheets("Matrice").Range("BA1").Value = "=TODAY()+6"
Sheets("Matrice").Range("BB1").Value = "=TODAY()+7"
Sheets("Matrice").Range("BC1").Value = "=TODAY()+8"
Sheets("Matrice").Range("BD1").Value = "=TODAY()+9"
Sheets("Matrice").Range("BE1").Value = "=TODAY()+10"
Sheets("Matrice").Range("BF1").Value = "=TODAY()+11"
Sheets("Matrice").Range("BG1").Value = "=TODAY()+12"
Sheets("Matrice").Range("BH1").Value = "=TODAY()+13"
'--------------------------------------------------------------------------------------------------------------------------
'Consolidation
'--------------------------------------------------------------------------------------------------------------------------
With ThisWorkbook
Set sh1 = .Sheets("PROD")
Set sh2 = .Sheets("Table")
Set sh3 = .Sheets("Matrice")
End With
Set SCOPE = Sheets("Dashboard").Range("A2")
Set dD = CreateObject("Scripting.Dictionary")
For j = 1 To 15
t1(1, j) = sh3.Cells(1, 45 + j).Value
dD(sh3.Cells(1, 45 + j).Value) = j 'Ici il faut également choisir la bonne colonne donc 45 + j et pas j seulement.
Next j
For i = LBound(t1) To UBound(t1)
t1(i, 1) = sh3.Cells(i, 46).Value
Next i
Set d = CreateObject("Scripting.Dictionary")
With sh2
i = 2
Do While .Cells(i, "A").Value <> ""
If .Cells(i, "Q").Value = SCOPE Then d("MSN " & .Cells(i, "A").Value) = ""
i = i + 1
Loop
End With
t2 = sh1.[A1].CurrentRegion.Value
For i = LBound(t2) To UBound(t2) Step 12 'Tu as ajouté une ligne dans PROD donc Step 12 et pas 11
If d.Exists(t2(i, 1)) Then
For j = LBound(t2, 2) + 1 To UBound(t2, 2)
If dD.Exists(t2(i, j)) Then
j1 = dD(t2(i, j))
For i1 = 1 To 10
t1(i1 + 1, j1) = t1(i1 + 1, j1) + t2(i + i1, j)
Next i1
End If
Next j
End If
Next i
sh3.[AT1].Resize(UBound(t1), UBound(t1, 2)).Formula = t1
'--------------------------------------------------------------------------------------------------------------------------
'Clear memory system - Inutile ici.
'--------------------------------------------------------------------------------------------------------------------------
Set sh1 = Nothing
Set sh2 = Nothing
Set sh3 = Nothing
Set d = Nothing
Set dD = Nothing
Set SCOPE = Nothing
End SubMerci thebenoit59.
J'avais complètement zappé le step.... Pourtant j'ai relu je sais combien de fois chaque étape.....
Merci de ton aide