Sub RappResp()
Dim rap(), RR, Ba, resp$, état$, n%, i%, j%, k%
'Affectation des critères à des variables chaîne ('String')
'Si le critère responsable manque, un message le signale et la procédure s'interrompt
'Si le critère état n'est pas servi, il est remplacé par un caractère joker ('*')
' permettant la prise en compte de tous les états
With Worksheets("Rapp.Resp")
If .Range("I6") <> "" Then
resp = .Range("I6").Value
If .Range("M6").Value <> "" Then
état = .Range("M6").Value
Else
état = "*"
End If
Else
MsgBox "Indiquer un nom de responsable (et éventuellement l'état recherché) avant de" _
& " lancer la constitution du rapport.", vbInformation, "Données initiales manquantes"
Exit Sub
End If
End With
'On affecte à la variable 'Ba' un tableau des numéros de colonnes des données à prélever dans la base
'On dimensionne une variable-tableau ('rap') sur 13 colonnes (0 à 12) pour recueillir les données
Ba = Array(1, 16, 19, 28, 29, 30, 31, 32, 9, 26, 25, 27, 24)
ReDim rap(12, 0)
'Prélèvement des données dans la base
'Si les critères responsable et état sont ceux sélectionnés (pour l'état comparaison au moyen de
' l'opérateur 'Like' permettant de l'ignorer s'il n'a pas été servi)
'On ajoute dans ce cas une ligne au tableau 'rap' (qu'on redimensionne au fur et à mesure)
With Worksheets("Base")
n = .Cells(.Rows.Count, 1).End(xlUp).Row
For i = 2 To n
If .Cells(i, 10) = resp And .Cells(i, 27) Like état Then
k = k + 1
ReDim Preserve rap(12, k)
For j = 0 To 12
If .Cells(i, Ba(j)) <> "" Then rap(j, k) = .Cells(i, Ba(j))
Next j
End If
Next i
End With
'Tri du tableau sur la priorité (élément d'indice 'colonne' 10 dans le tableau 'rap')
' (l'indice 'ligne' 0 est utilisé pour procéder aux substitutions ('switch') destinées à
' reclasser les lignes du tableau)
For i = 1 To k - 1
For j = i + 1 To k
If rap(10, j) < rap(10, i) Then
For n = 0 To 12
rap(n, 0) = rap(n, i)
rap(n, i) = rap(n, j)
rap(n, j) = rap(n, 0)
Next n
End If
Next j
Next i
'On affecte à la variable 'RR' un tableau des colonnes cible à servir (opération nécessaire en
' raison des fusions de cellules)
RR = Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 13, 17, 18, 19)
'Affectation du tableau trié à la feuille cible
With Worksheets("Rapp.Resp")
n = .Cells(.Rows.Count, 1).End(xlUp).Row
If n >= 11 Then .Range("A11:S" & n).ClearContents
For i = 1 To k
For j = 0 To 12
.Cells(i + 10, RR(j)).Value = rap(j, i)
Next j
Next i
End With
End Sub