VBA : trouver la largeur d'une cellule fusionnée

Version imprimable

16/12/2021, 14h44
NikoJ

1 pièce(s) jointe(s)

VBA : trouver la largeur d'une cellule fusionnée

Bonjour à tous.

Je cherche, via du code VBA, à calculer l'éligibilité d'une personne à un échelon afin de construire un rapport rapide.

Pour cela, j'ai un listing (de 900 lignes) avec les dates d'obtention de l'échelon (plusieurs types d'échelons et de grades, tout est mélangé).
J'ai également un tableau qui, en fonction de l'échelon, me donne l'ancienneté minimum pour accéder à l'échelon suivant.

Mon listing couvre les années 2019 à 2021, mais je vais devoir rajouter 2022 dans peu de temps.
J'ai pu sortir un code (à la bourrin mais qui marche) en allant, colonne par colonne chercher l'information qu'il me faut.
Sauf que, demain, si j'ajoute la colonne 2022 en dessous de "date échelon", tout mon code va craquer. Tout sera décalé à droite et je devrais tout reprendre.

Je voudrais pouvoir sortir un code qui :
1 trouve la cellule "date echelon" (ça c'est bon et ça marche)
2 me donne la largeur de la cellule "date echelon". Aujourd'hui elle fait '3' (de D à F), demain elle fera '4' (de D à G) - voir image en PJ
3 parcours les cellules en dessous de "date echelon" pour obtenir l'année d'obtention de l'échelon.
-> Comment créer une boucle sur les lettres de l'alphabet pour aller de la première colonne de la cellule 'date echelon' à la dernière colonne de la cellule 'date echelon'?
4 calcul l'année d'éligibilité à l'échelon suivant (ça c'est bon et ça marche grâce à des bouts de code pour 'jouer' avec les dates trouvés sur ce forum)

ex listing source :
Pièce jointe 610320

Oui ce serait plus simple de créer de nouvelles colonnes "date éligibilité echelon sup" mais le fichier source contient beaucoup d'autres informations sur les personnes. Impossible de bidouiller directement dans ce listing
Le but du code VBA est de créer un nouvel onglet (voir un fichier) avec les informations d'éligibilité. Elles pourront être exploitées indépendamment du listing source.

Merci de votre aide.

1 pièce(s) jointe(s)

Bonjour
je sais pas si c'est ce que tu cherches :

Code:

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
Sub regroup()
Application.ScreenUpdating = False
Dim F1 As Worksheet
Dim F2 As Worksheet
Dim derlig As Long
Dim dercol As Long
Set F1 = Sheets("BASE")
Set F2 = Sheets("RESULTAT")
F2.Cells.ClearContents
Dim i As Long
Set d = CreateObject("Scripting.Dictionary")
F2.Cells(1, 1) = "Nom"
F2.Cells(1, 2) = "Grade"
F2.Cells(1, 3) = "Année Ech"
dercol = F1.Cells(2, F1.Cells.Columns.Count).End(xlToLeft).Column
derlig = F1.Range("A" & Rows.Count).End(xlUp).Row
 
    TblBD = F1.Range(F1.Cells(2, 1), F1.Cells(derlig, dercol))
    For i = 1 To UBound(TblBD)
    For C = 3 To dercol
    If TblBD(i, C) = "X" Then
    clé = TblBD(i, 1) & "|" & TblBD(i, 2) & "|" & TblBD(1, C)
    d(clé) = d(clé)
   End If
     Next C
     Next i
 F2.Range("A2").Resize(d.Count) = Application.Transpose(d.keys)
 Application.DisplayAlerts = False
 F2.Range("A2").Resize(d.Count).TextToColumns Other:=1, OtherChar:="|"
Application.ScreenUpdating = True
End Sub

En continuant à fouiller, j'ai trouvé le Cells(x,y) qui prend des valeurs numériques comme repère pour les colonnes. Du coup j'ai pondu ce code :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 Private Sub cmdTests_Click() Dim colDebut, colFin As Integer Dim shListing As Worksheet Set shListing = Worksheets("LISTING") colDebut = 1 'je cherche la colonne de départ Do While shListing.Cells(1, colDebut) <> "date echelon" colDebut = colDebut + 1 Loop 'je cherche la colonne de fin colFin = colDebut + 1 Do While shListing.Cells(1, colFin) = "" colFin = colFin + 1 Loop 'je suis aller une colonne trop loin, je retire 1 colFin = colFin - 1 MsgBox (colDebut & " // " & colFin & " // " & shListing.Cells(1, colDebut) & " - " & shListing.Cells(1, colFin + 1)) Set shListing = Nothing End Sub
Mon msgbox affiche les bonnes valeurs de colonnes pour le début et la fin ainsi que la la valeur de la cellule fusionnée 'date échelon' et la valeur de la cellule fusionnée suivante.
Du coup ça marche.
Je trouve ça un peu crado comme code mais bon...
Je le laisse là pour inspirer d'autres ou si vous avez une meilleure idée...

@ plus ...

16/12/2021, 16h41
NikoJ

Citation:

Envoyé par BENNASR

je sais pas si c'est ce que tu cherches :

Bonjour
Merci pour la réponse.
A lire, ça à l'air d'être ça. Mais un peu trop compliqué pour mon vieux cerveau qui n'a pas codé depuis plus de 20 ans...

Merci pour la proposition. Ma solution juste au-dessus fonctionne très bien.
Elle est surtout plus évidente à comprendre (même si pas très propre). Elle pourra être reprise par n'importe qui en cas de modification ultérieure.

Cdlt,
NikoJe