Boucle sur cellule .vbs

[SF.Designer]

Bonjour a tous,

Pour info, c'est la première fois que je met le nez dans vbs/vba, soyez indulgent mais critique.

Bon je n'arrive pas a mettre la dernière touche sur un script vbs, après moulte recherche et surtout après avoir testé plein de solutions différentes.

Nous avons des fichiers créés par le Progiciel qui viens sur Autocad, qui sont des fichier .DAT, sous cette forme :

J'arrive a les transformer en Excel, a les mettre en forme, trier, puis a les réunir.


J'aimerais, avant de les réunir, procédé a une boucle qui me comptabilise les élément aillant le même code.
J'arrive pour le moment a détecter la valeur et le nombre de la première occurrence, sélectionner la cellule suivante puis détecter son nombre.
Je n'arrive pas a mettre en place une boucle sur la deuxième détection, afin que cela passe a la case suivante et ainsi de suite jusqu'à une cellule vide.

Le bout de code qui me pose problème :
 

				
	'*** Comptage
	' Nombre de cellules valeur D2, premiére occurence
	objCellsCodeStart = objSheet.range("D2").Value 
	objSheet.range("F2") = objCellsCodeStart
	objCellsCodeStartCompteur = .WorksheetFunction.CountIf(.Range("D:D"), objCellsCodeStart)
	objSheet.range("F3") = objCellsCodeStartCompteur
	
	'*** boucle a faire avec cette partie de code
	objCellsCodeLoop = objSheet.range("D2").Offset(objSheet.range("F3").Value, 0) 'Ligne suivant la premiére occurence trouvé
	objSheet.range("F2").Offset(0, 1) = objCellsCodeLoop
	
	objCellsCodeLoopCompteur = .WorksheetFunction.CountIf(.Range("D:D"), objCellsCodeLoop)
	objSheet.range("G3") = objCellsCodeLoopCompteur
	'*** boucle a faire avec cette partie de code

 

Le but étant d'inscrire :
- F2 la première occurrence, F3 son nombre
- G2 la deuxième occurrence, G3 son nombre
- H2  ..., H3 ...
- Etc........

La boucle doit s'arrêter quand il tombe sur la première cellule vide a la fin de la colonne D.

 

Je vous joins aussi le script entier et 2 fichier DAT pour test.

ExtractDAT.vbs CH1_A.dat CH2_A.dat CH3_A0.dat

[didier]

Bonjour @SF.Designer

Cette macro est à utiliser dans le classeur Excel ?

Amicalement

[SF.Designer]

Bonjour,
Non en fait c'est un VBS externe, une fois lancer je dois sélectionner un dossier avec fichier source DAT, puis un dossier de destination et ca mouline !

 

[didier]

Bonjour @SF.Designer

D'accord, du coup, je ne comprends pas ce qu'il faut faire.
Le départ est un classeur Excel ?
Faut-il scanner la feuille en cours ou toutes les feuilles ?

En F2  qu'est-ce que la valeur 102 ? et en F3 qu'est-ce que la valeur 210 ?

Amicalement

[SF.Designer]

Pour le moment le script fait :
- Copie des fichiers DAT dans le dossier de destination
- Modification des DAT en excel, avec traitement "Trier, bordure etc..."
- Réunir les fichiers en un seul Excel.

Maintenant j'aimerais comptabiliser les éléments commun de la colonne D et inscrire automatique le résultat comme suis :
En F2 le code 102 (cellule D2), en F3 le nombre d'occurrence de 102 trouvé.
En G2 le code suivant le 102 dans le tableau, ici 210, en G3 le nombre d'occurrence de 210 trouvé.
En H2  le code suivant..... H3 son nombre

Se traitement se fait avant de réunir toutes les feuilles dans un classeur commun

[didier]

Bonjour @SF.Designer

En chargeant le CH1_A.dat, je n'obtiens pas quelque chose de ressemblant à ce qui est montré dans le premier message.
Est-il possible de travailler à la recherche de solution depuis le fichier Excel ?

Amicalement

[SF.Designer]

Merci Didier

Finalement en testant une autre solution, j'ai trouvé mon graal hehe

 

 '*** Comptage des occurrences des valeurs uniques dans la colonne D
                Dim lastRow, i, cellValue
                Dim uniqueDict
                lastRow = objSheet.Cells(objSheet.Rows.Count, "D").End(-4162).Row ' -4162 = xlUp
                Set uniqueDict = CreateObject("Scripting.Dictionary")
                
                ' Parcourir la colonne D et compter les occurrences
                For i = 2 To lastRow
                    cellValue = objSheet.Cells(i, 4).Value ' Colonne D est la 4ème colonne
                    If Not uniqueDict.Exists(cellValue) Then
                        uniqueDict.Add cellValue, 1
                    Else
                        uniqueDict(cellValue) = uniqueDict(cellValue) + 1
                    End If
                Next
                
                ' Écriture des résultats dans les colonnes F et G
                Dim outputColumn
                outputColumn = 6 ' Débuter à la colonne F (6ème colonne)
                For Each dictKey In uniqueDict.Keys
                    ' Écrire la valeur unique en ligne 1
                    objSheet.Cells(1, outputColumn).Value = dictKey
                    ' Écrire le nombre d'occurrences en ligne 2
                    objSheet.Cells(2, outputColumn).Value = uniqueDict(dictKey)
                    ' Ajouter une bordure autour des cellules contenant les valeurs
                    With objSheet.Cells(1, outputColumn).Borders
                        .LineStyle = xlContinuous
                        .Weight = xlMedium
                    End With
                    With objSheet.Cells(1, outputColumn).Font
                        .Bold = True
                        .Name = "Verdana"
                        .Size = 11
                    End With
                    ' Ajouter une bordure fine autour des cellules contenant les résultats
                    With objSheet.Cells(2, outputColumn).Borders
                        .LineStyle = xlContinuous
                        .Weight = xlThin
                    End With
                    With objSheet.Cells(2, outputColumn).Font
                        .Name = "Verdana"
                        .Size = 10
                    End With
                    outputColumn = outputColumn + 1 ' Passer à la colonne suivante
                Next

 

[didier]

Bonjour @SF.Designer

Je suis désolé de ne pas avoir pu répondre, toutefois je suis bien content que la solution soit trouvée.
Même si je n'ai pas pris soin de relire le code.

Amicalement