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
| Function MULTIPLEVLOOKUP(lookupval, lookuprange As Range, indexcol As Long)
Dim lastLine As Integer, i As Integer
Application.ScreenUpdating = False
'derniere ligne de la base'
lastLine = 9999
Dim tab_bd() As String
ReDim tab_bd(lastLine, 2)
For i = 0 To lastLine
tab_bd(i, 0) = Range("A" & i + 2)
tab_bd(i, 1) = Sheets("TORXX").Range("B" & i + 2)
Next
Dim j As Integer
j = 2
For j = 2 To 4600
For i = 1 To lastLine
If tab_bd(j, 0) = tab_bd(i, 1) Then
If Trim(tab_bd(j - 2, 2) & vbNullString) = vbNullString Then
'MsgBox Sheets("TORXX").Range("A" & i + 2) & ", "
tab_bd(j - 2, 2) = Sheets("TORXX").Range("A" & i + 2) & ", "
Else
tab_bd(j - 2, 2) = tab_bd(j - 2, 2) & Sheets("TORXX").Range("A" & i + 2)
End If
End If
Next
Next
Dim s As Integer
s = 0
---------------------------------------------
For i = 3 To 30 zone en pointillé est je pense la partie qui bug. Merci beaucoup
Range("B" & i + 1) = tab_bd(s, 2)
s = s + 1
Next
---------------------------------------------
Application.ScreenUpdating = True
End Function |
Partager