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 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62
| Option Explicit
Const DOM As String = "domicile"
'On va remplir Feuil1.Range("A4:E16") à partir de la liste des nom se trouvant en Feuil2.Range("A4:A15")
Sub REMPLIR()
Application.ScreenUpdating = False
DISPATCH Feuil2.Range("A4:A15"), Feuil1.Range("A4:E16")
End Sub
Private Sub DISPATCH(ByVal RngN As Range, ByVal RngP As Range)
Dim M As Long, N As Long, Nb As Long, i As Long, j As Long
Dim k As Integer, ColMax As Integer, ColIni As Integer
Dim Typ As String
Dim TbN, TbP
TbN = RngN.Value
TbP = RngP.Resize(RngP.Rows.Count + 1, RngP.Columns.Count + 1).Value
Typ = RngP.Offset(, 1).Resize(, 1).Address
Nb = Evaluate("3*COUNTA(" & Typ & ")-COUNTIF(" & Typ & ",""" & DOM & """)")
AleaTab TbN
N = UBound(TbN, 1)
j = 1
k = IIf(TbP(1, 2) = DOM, 5, 3)
For i = 1 To Nb
M = IIf(i Mod N = 0, N, i Mod N)
TbP(j, k) = UCase(TbN(M, 1))
ColMax = IIf(TbP(j, 2) = DOM, 6, 5)
k = k + 1
If k > ColMax Then
j = j + 1
k = IIf(TbP(j, 2) = DOM, 5, 3)
End If
Next i
For i = 1 To UBound(TbP, 1)
If TbP(i, 3) <> "" Then TbP(i, 3) = TbP(i, 3) & " / " & TbP(i, 4)
TbP(i, 4) = TbP(i, 5)
TbP(i, 5) = TbP(i, 6)
Next i
RngP = TbP
End Sub
Private Sub AleaTab(ByRef Tbl)
Dim i As Long, j As Long, N As Long
Dim Tmp As String
N = UBound(Tbl, 1)
Randomize
For i = 1 To N
j = CLng(((N - i) * Rnd) + i)
If i <> j Then
Tmp = Tbl(i, 1)
Tbl(i, 1) = Tbl(j, 1)
Tbl(j, 1) = Tmp
End If
Next i
End Sub |
Partager