Mise en Forme Tableau
Bonjour,
J'ai de nouveaux besoins d'aide de la part de votre communauté. J'ai créé un code VBA connecté à une base de données SQL et j'ai effectué les liaisons entre les tableaux. Maintenant, j'essaie de mettre tout cela en forme.
Je ne peux malheureusement pas vous joindre le fichier car nous sommes sur un serveur privé. Cependant, je peux vous envoyer le code ainsi que des photos pour que vous puissiez visualiser mon problème.
Sur les quatre lignes surlignées, on observe que ces lignes ont le même numéro de BT et, par conséquent, le même titre. J'aimerais pouvoir retirer ces doublons. De plus, dans les autres colonnes, il y a également des répétitions inutiles. Par exemple, dans la colonne D (la pièce sortie), une pièce apparaît deux fois parce qu'il y a deux intervenants et donc deux quantités identiques, alors que la pièce n'a été sortie qu'une seule fois. Mon tableau hebdomadaire, qui sert à visualiser toutes les pièces sorties cette semaine, considère que la pièce a été sortie deux fois.
Ce que je voudrais, c'est obtenir un tableau avec un seul numéro de BT et un seul titre, en consolidant les pièces sorties sans doublons ou répétitions multiples. Il doit y avoir une seule occurrence pour chaque pièce avec sa propre quantité, son emplacement (les doublons sont autorisés pour cette colonne car certaines pièces ont le même emplacement), ainsi que tous les intervenants ayant participé à la tâche. L'état du BT et la date doivent également apparaître une seule fois.
Merci pour votre aide.
je vous joint photo est code
Sub Mouvement()
Dim conn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim strSql As String
Dim strConn As String
Dim ws As Worksheet
Dim rowNum As Long
Dim lastRow As Long
Set ws = ThisWorkbook.Sheets("Feuil2")
strConn = "Provider=SQLOLEDB;Data Source=SVM01033\GMAO;Initial Catalog=Ceyzeriat;User ID=GMAO;Password=masterkey;"
Set conn = New ADODB.Connection
conn.Open strConn
strSql = "SELECT T_BT.NUM_BT, T_BT.TITRE_BT,T_PIECE_SUB.CODE AS CODE_PIECE,T_LIEUSTOCK.DES_LIEUSTOCK,T_PIECE_LIGNE.QTE,T_INTERV_SUB.NOM_INTERV AS NOM_INTERVENANT, " & _
"T_ETAT_BT.DES_ETAT_BT, T_BT.DATE_H_CLOT " & _
"FROM T_BT " & _
"LEFT JOIN T_LIGNE_BT AS T_PIECE_LIGNE ON T_BT.NUM_BT = T_PIECE_LIGNE.CLE_BT AND T_PIECE_LIGNE.TYPE_LIGNE_BT = 'P' " & _
"LEFT JOIN T_PIECE AS T_PIECE_SUB ON T_PIECE_LIGNE.CLE_ELEMENT = T_PIECE_SUB.CLE_PIECE " & _
"LEFT JOIN T_LIGNE_BT AS T_INTERV_LIGNE ON T_BT.NUM_BT = T_INTERV_LIGNE.CLE_BT AND T_INTERV_LIGNE.TYPE_LIGNE_BT = 'I' " & _
"LEFT JOIN T_INTERV AS T_INTERV_SUB ON T_INTERV_LIGNE.CLE_ELEMENT = T_INTERV_SUB.NUM_INTERV " & _
"LEFT JOIN T_STOCK ON T_PIECE_SUB.CLE_PIECE = T_STOCK.CLE_PIECE " & _
"LEFT JOIN T_LIEUSTOCK ON T_STOCK.CLE_LIEU_STOCK = T_LIEUSTOCK.NUM_LIEUSTOCK " & _
"LEFT JOIN T_ETAT_BT ON T_BT.CLE_ETAT_BT = T_ETAT_BT.CLE_ETAT_BT " & _
"LEFT JOIN T_MVT AS T_MVT_LIGNE ON T_PIECE_LIGNE.NUM_LIGNE_BT= T_MVT_LIGNE.CLE_LIEN " & _
"ORDER BY T_BT.NUM_BT"
Set rs = New ADODB.Recordset
rs.Open strSql, conn
ws.Cells.Clear
ws.Cells(1, 1).Value = "N°bt"
ws.Cells(1, 2).Value = "Titre"
ws.Cells(1, 3).Value = "Code Pièce"
ws.Cells(1, 4).Value = "Emplacement De La Pièce"
ws.Cells(1, 5).Value = "Quantité"
ws.Cells(1, 6).Value = "Intervenant"
ws.Cells(1, 7).Value = "Etat"
ws.Cells(1, 8).Value = "Date de la Cloture"
rowNum = 2
If Not rs.EOF Then
ws.Cells(rowNum, 1).CopyFromRecordset rs
Else
MsgBox "Aucune donnée trouvée !", vbExclamation
GoTo CleanUp
End If
lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
For rowNum = 2 To lastRow
If IsEmpty(ws.Cells(rowNum, 1).Value) Then
ws.Cells(rowNum, 1).Value = "Pas de code"
End If
If IsEmpty(ws.Cells(rowNum, 2).Value) Then
ws.Cells(rowNum, 2).Value = "Pas de désignation"
End If
If IsEmpty(ws.Cells(rowNum, 3).Value) Then
ws.Cells(rowNum, 3).Value = "Pas de Pièce Sortie "
End If
If IsEmpty(ws.Cells(rowNum, 4).Value) Then
ws.Cells(rowNum, 4).Value = "Pas de titre BT"
End If
If IsEmpty(ws.Cells(rowNum, 5).Value) Then
ws.Cells(rowNum, 5).Value = "intervenant exterieur ou oublie"
End If
Next rowNum
Dim tbl As ListObject
Set tbl = ws.ListObjects.Add(xlSrcRange, ws.Range("A1:H" & lastRow), , xlYes)
tbl.Name = "SelectedData"
tbl.TableStyle = "TableStyleMedium11"
With ws
.Columns("A:H").AutoFit
.Range("A1:H1").Font.Bold = True
.Range("A1:H1").Interior.Color = RGB(38, 96, 164)
End With
ws.Calculate
MsgBox "Données importées avec succès!", vbInformation
CleanUp:
rs.Close
conn.Close
Set rs = Nothing
Set conn = Nothing
End Sub
Je vous ajoute le classeur contenant les valeurs de la photo pour plus de praticité. Je vous remercie encore pour votre aide.
Bonjour,
Pour être complet, votre fichier aurait dû contenir la ligne d'entêtes, et un tableau avec le résultat attendu.
Un essai, le code vérifie si toutes les cellules de chaque ligne sont identiques (sauf pour l'intervenant) et les supprime si c'est le cas.
Cdlt
Bonjour,
Le forum comporte quelques outils :
Pour une meilleure lisibilité et préserver l'indentation, veuillez utiliser la balise code (cerclée en rouge) avant de coller du VBA.
A+
Bonjour Arturo83,
Je vous remercie pour votre message. J'aimerais appliquer une mise en forme spécifique à mon tableau, mais je ne suis pas certain que ce soit réalisable ou si cela pourrait causer des complications. Cependant, c'est le format qui me conviendrait le mieux.
Pour vous illustrer précisément ce que je souhaite, je vous ai renvoyé votre fichier avec une nouvelle feuille contenant des exemples supplémentaires de la mise en forme désirée.
Je vous remercie encore une fois pour votre aide et votre réponse.
Essayez ceci:
Sub Consolidation()
Dim DerLig As Long, i As Long
Dim Code_Piece As String, Emplacement As String, Intervenant As String
Application.ScreenUpdating = False
DerLig = Range("A" & Rows.Count).End(xlUp).Row
For i = DerLig - 1 To 2 Step -1
If Cells(i, "A") = Cells(i + 1, "A") And Cells(i, "B") = Cells(i + 1, "B") And _
Cells(i, "G") = Cells(i + 1, "G") And Cells(i, "H") = Cells(i + 1, "H") Then
Code_Piece = Cells(i, "C")
If InStr(1, Cells(i + 1, "C"), Code_Piece, 1) = 0 Then
Cells(i, "C") = Cells(i, "C") & Chr(10) & Cells(i + 1, "C")
Else
Cells(i, "C") = Cells(i + 1, "C")
End If
Emplacement = Cells(i, "D")
If InStr(1, Cells(i + 1, "D"), Emplacement, 1) = 0 Then
Cells(i, "D") = Cells(i, "D") & Chr(10) & Cells(i + 1, "D")
Else
Cells(i, "D") = Cells(i + 1, "D")
End If
Intervenant = Cells(i, "F")
If InStr(1, Cells(i + 1, "F"), Intervenant, 1) = 0 Then
Cells(i, "F") = Cells(i, "F") & Chr(10) & Cells(i + 1, "F")
Else
Cells(i, "F") = Cells(i + 1, "F")
End If
Range(Cells(i + 1, "A"), Cells(i + 1, "H")).Delete
End If
Next i
End SubCdlt
Oui, cela fonctionne, mais il y a un problème : la quantité n'est plus liée à chaque pièce et disparaît, laissant une seule quantité affichée.
Bonjour
Cela doit se régler au niveau de la requête et non a postériori : la colonne Intervenant est-elle utile ?
Avec 365 le plus simple est de faire la requête via PowerQuery et non VBA + ADODB.
Cela permet d'obtenir directement le résultat souhaité sans bidouiller à posteriori...
PowerQuery peut utiliser le SQL
Oui, il serait utile d'avoir l'intervenant, mais malheureusement, il est trop tard pour revenir sur Power Query, que je n'ai jamais utilisé.
Ok, j'ai zappé une étape, le correctif:
Sub Consolidation()
Dim DerLig As Long, i As Long
Dim Code_Piece As String, Emplacement As String, Intervenant As String
Application.ScreenUpdating = False
DerLig = Range("A" & Rows.Count).End(xlUp).Row
For i = DerLig - 1 To 2 Step -1
Flag = 0
If Cells(i, "A") = Cells(i + 1, "A") And Cells(i, "B") = Cells(i + 1, "B") And _
Cells(i, "G") = Cells(i + 1, "G") And Cells(i, "H") = Cells(i + 1, "H") Then
Code_Piece = Cells(i, "C")
If InStr(1, Cells(i + 1, "C"), Code_Piece, 1) = 0 Then
Cells(i, "C") = Cells(i, "C") & Chr(10) & Cells(i + 1, "C")
Else
Cells(i, "C") = Cells(i + 1, "C")
End If
Emplacement = Cells(i, "D")
If InStr(1, Cells(i + 1, "D"), Emplacement, 1) = 0 Then
Cells(i, "D") = Cells(i, "D") & Chr(10) & Cells(i + 1, "D")
Else
Cells(i, "D") = Cells(i + 1, "D")
End If
Intervenant = Cells(i, "F")
If InStr(1, Cells(i + 1, "F"), Intervenant, 1) = 0 Then
Cells(i, "F") = Cells(i, "F") & Chr(10) & Cells(i + 1, "F")
Else
Cells(i, "F") = Cells(i + 1, "F")
End If
If InStr(1, Cells(i + 1, "C"), Code_Piece, 1) = 0 Or InStr(1, Cells(i + 1, "D"), Emplacement, 1) = 0 Then
Cells(i, "E") = Cells(i, "E") & Chr(10) & Cells(i + 1, "E")
Else
Cells(i, "E") = Cells(i + 1, "E")
End If
Range(Cells(i + 1, "A"), Cells(i + 1, "H")).Delete
End If
Next i
End SubCdlt
RE
C'est très simple à faire dans PowerQuery.
Oui, il serait utile d'avoir l'intervenant, mais malheureusement, il est trop tard pour revenir sur Power Query, que je n'ai jamais utilisé.
PowerQuery est plus facile à apprendre que VBA...
Exemple refait sur le tien auquel j'ai ajouté une ligne sans doublons pour vérifier que cela fonctionne dans les 2 cas...
Sub GetSelectedDataFromSQLServer()
Dim conn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim strSql As String
Dim strConn As String
Dim ws As Worksheet
Dim rowNum As Long
Dim lastRow As Long
Dim tbl As ListObject
On Error GoTo ErrorHandler
Set ws = ThisWorkbook.Sheets("Feuil2")
strConn = "Provider=SQLOLEDB;Data Source=SVM01033\GMAO;Initial Catalog=Ceyzeriat;User ID=GMAO;Password=masterkey;"
Set conn = New ADODB.Connection
conn.Open strConn
strSql = "SELECT T_BT.NUM_BT, T_BT.TITRE_BT, T_PIECE_SUB.CODE AS CODE_PIECE, T_LIEUSTOCK.DES_LIEUSTOCK, T_PIECE_LIGNE.QTE, T_INTERV_SUB.NOM_INTERV AS NOM_INTERVENANT, " & _
"T_ETAT_BT.DES_ETAT_BT, T_BT.DATE_H_CLOT " & _
"FROM T_BT " & _
"LEFT JOIN T_LIGNE_BT AS T_PIECE_LIGNE ON T_BT.NUM_BT = T_PIECE_LIGNE.CLE_BT AND T_PIECE_LIGNE.TYPE_LIGNE_BT = 'P' " & _
"LEFT JOIN T_PIECE AS T_PIECE_SUB ON T_PIECE_LIGNE.CLE_ELEMENT = T_PIECE_SUB.CLE_PIECE " & _
"LEFT JOIN T_LIGNE_BT AS T_INTERV_LIGNE ON T_BT.NUM_BT = T_INTERV_LIGNE.CLE_BT AND T_INTERV_LIGNE.TYPE_LIGNE_BT = 'I' " & _
"LEFT JOIN T_INTERV AS T_INTERV_SUB ON T_INTERV_LIGNE.CLE_ELEMENT = T_INTERV_SUB.NUM_INTERV " & _
"LEFT JOIN T_STOCK ON T_PIECE_SUB.CLE_PIECE = T_STOCK.CLE_PIECE " & _
"LEFT JOIN T_LIEUSTOCK ON T_STOCK.CLE_LIEU_STOCK = T_LIEUSTOCK.NUM_LIEUSTOCK " & _
"LEFT JOIN T_ETAT_BT ON T_BT.CLE_ETAT_BT = T_ETAT_BT.CLE_ETAT_BT " & _
"LEFT JOIN T_MVT AS T_MVT_LIGNE ON T_PIECE_LIGNE.NUM_LIGNE_BT= T_MVT_LIGNE.CLE_LIEN " & _
"ORDER BY T_BT.NUM_BT"
Set rs = New ADODB.Recordset
rs.Open strSql, conn
ws.Cells.Clear
ws.Cells(1, 1).Value = "N°bt"
ws.Cells(1, 2).Value = "Titre"
ws.Cells(1, 3).Value = "Code Pièce"
ws.Cells(1, 4).Value = "Emplacement De La Pièce"
ws.Cells(1, 5).Value = "Quantité"
ws.Cells(1, 6).Value = "Intervenant"
ws.Cells(1, 7).Value = "Etat"
ws.Cells(1, 8).Value = "Date de la Cloture"
rowNum = 2
If Not rs.EOF Then
ws.Cells(rowNum, 1).CopyFromRecordset rs
Else
MsgBox "Aucune donnée trouvée !", vbExclamation
GoTo CleanUp
End If
lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
For rowNum = lastRow To 2 Step -1
If ws.Cells(rowNum, "A") = ws.Cells(rowNum - 1, "A") And ws.Cells(rowNum, "B") = ws.Cells(rowNum - 1, "B") And _
ws.Cells(rowNum, "G") = ws.Cells(rowNum - 1, "G") And ws.Cells(rowNum, "H") = ws.Cells(rowNum - 1, "H") Then
If InStr(1, ws.Cells(rowNum - 1, "C"), ws.Cells(rowNum, "C").Value, vbTextCompare) = 0 Then
ws.Cells(rowNum - 1, "C") = ws.Cells(rowNum - 1, "C") & Chr(10) & ws.Cells(rowNum, "C").Value
End If
ws.Cells(rowNum - 1, "D") = ws.Cells(rowNum - 1, "D") & Chr(10) & ws.Cells(rowNum, "D").Value
If InStr(1, ws.Cells(rowNum - 1, "F"), ws.Cells(rowNum, "F").Value, vbTextCompare) = 0 Then
ws.Cells(rowNum - 1, "F") = ws.Cells(rowNum - 1, "F") & Chr(10) & ws.Cells(rowNum, "F").Value
End If
If InStr(1, ws.Cells(rowNum - 1, "E"), ws.Cells(rowNum, "E").Value, vbTextCompare) = 0 Then
ws.Cells(rowNum - 1, "E") = ws.Cells(rowNum - 1, "E") & Chr(10) & ws.Cells(rowNum, "E").Value
End If
ws.Rows(rowNum).Delete
End If
Next rowNum
Set tbl = ws.ListObjects.Add(xlSrcRange, ws.Range("A1:H" & lastRow), , xlYes)
tbl.Name = "SelectedData"
tbl.TableStyle = "TableStyleMedium11"
With ws
.Columns("A:H").AutoFit
.Range("A1:H1").Font.Bold = True
.Range("A1:H1").Interior.Color = RGB(38, 96, 164)
End With
ws.Calculate
MsgBox "Données importées et consolidées avec succès!", vbInformation
CleanUp:
rs.Close
conn.Close
Set rs = Nothing
Set conn = Nothing
Exit Sub
ErrorHandler:
MsgBox "Erreur : " & Err.Description, vbCritical
Resume CleanUp
End SubSalut tout le monde,
Arturo, ton code fonctionne à merveille, je dois admettre que je n'y avais pas pensé. Cependant, il est plus compliqué de l'intégrer dans mon fichier où j'importe les données, car cela plante (nous avons plus de 500 000 valeurs). Honnêtement, je ne sais pas s'il y a un moyen de l'optimiser. Je l'ai séparé de mon code, mais cela ne fonctionne toujours pas. J'ai également apporté quelques modifications pour qu'il accepte les doublons d'emplacement, car il arrive que nous ayons des pièces différentes au même emplacement.
Bonsoir,
Avec un extrait des données non confidentielles, de votre fichier, je pourrai voir ce qui cloche.
Cdlt
Bien sûr, voici un classeur contenant toutes les données, mais sans la connexion au serveur, car il est impossible de vous y connecter depuis votre ordinateur.
*Le classeur ne contient pas toutes les données en raison de la taille limitée imposée par ce forum.
Bonjour,
J'ai fait une autre approche, dans un premier temps, "Consolidation" ,toutes les lignes en doubles sont marquées d'un "X" en colonne "I", puis dans un deuxième temps, en cliquant sur le bouton "Suppression", cela supprime toutes les lignes content un "X" en colonne "I".
Cdlt
Bonjour à tous
Bien que PowerQuery ait été rejété (de même que ma participation
Mon tableau hebdomadaire, qui sert à visualiser toutes les pièces sorties cette semaine, considère que la pièce a été sortie deux fois.
(j'ai éliminé les lignes sans sortie mais on peut les conserver si nécessaire)
Une simple actualisation suffit...
Beaucoup ici ont compris qu'en intégrant les possibilités existant dans Excel depuis 14 ans, ils avaient tout à y gagner, alors je ne me décourage pas...
Bonjour,
Malheureusement, cela ne fonctionne pas correctement. Je vous joint le petit exemple de ce que cela donne. J'ai également essayé la technique du Power Query, qui fonctionne très bien, mais j'ai un problème de latence et d'actualisation.
En ce qui concerne le code VBA, j'ai essayé plusieurs combinaisons, mais je pense que je manque de compétences dans ce domaine. En fait, il est acceptable d'avoir des doublons dans les colonnes "Titre" et "Emplacement". Par contre, le numéro de BT doit être unique comme l'emplacement et la quantité qui est liée a la pièce, l'intervenant ou les intervenant aussi ne doivent apparaitre qu'une fois, et c'est ce que je n'arrive pas à appliquer(a cause également de la taille du fichier qi complique un peu tout )
Je vous remercie encore pour votre aide
Bien cordialement
Bonjour 78chris,
Je suis désolé si vous avez eu l'impression que je vous ai "snobé". Votre technique fonctionne très bien, mais j'ai trop de lignes (198,000). J'aimerais aussi vous poser une question : dans votre tableau, les répétitions sont supprimées (ce qui est très bien), mais cela se produit également dans la colonne "Emplacement".
Merci pour votre réponse.