Sub GetGidPacTxT()
Dim UM As Worksheet, InitRowUM As Long, VA, L, x As Long, Txt$, y As Integer, i As Integer, T!
Dim FindPAC As Integer, S, V, Pos As Integer, PAC, GID, gidValue$, gidPart$, sumResult As Double
SupprimerDonneesUM
T = Timer
VA = ThisWorkbook.Sheets("BD").ListObjects(1).DataBodyRange.Value
Set UM = ThisWorkbook.Sheets("UM")
InitRowUM = 10
Application.ScreenUpdating = False
L = GetBordereau(CStr(UM.Range("D3").Value)) 'Cherche les lignes correspondante au borderau
If L <> "" Then
L = Split(L, "|")
For x = LBound(L) To UBound(L)
Txt = VA(L(x), 2): FindPAC = InStr(Txt, "DIM+PAC+")
If FindPAC = 0 Then
ReDim V(1 To 1, 1 To 9)
V(1, 1) = VA(L(x), 3): V(1, 2) = VA(L(x), 1): V(1, 3) = VA(L(x), 5): V(1, 4) = VA(L(x), 6): V(1, 5) = VA(L(x), 7)
V(1, 6) = VA(L(x), 8): V(1, 7) = VA(L(x), 9): V(1, 8) = VA(L(x), 10): V(1, 9) = VA(L(x), 11)
UM.Cells(InitRowUM, 1).Resize(UBound(V), UBound(V, 2)).Value = V
InitRowUM = InitRowUM + 1
Else
S = Split(Txt, "DIM+PAC+")
ReDim V(1 To UBound(S), 1 To 15)
For y = LBound(S) To UBound(S)
i = y + 1: Pos = InStrRev(S(y), "GID++") + 5
GID = Split(Mid(S(y), Pos, 10), ":"): gidValue = GID(0): gidPart = GID(1): PAC = Split(S(i), ":")
V(i, 1) = VA(L(x), 3): V(i, 2) = VA(L(x), 1): V(i, 3) = VA(L(x), 5): V(i, 4) = VA(L(x), 6): V(i, 5) = VA(L(x), 7)
V(i, 6) = VA(L(x), 8): V(i, 7) = VA(L(x), 9): V(i, 8) = VA(L(x), 10): V(i, 9) = VA(L(x), 11)
V(i, 11) = PAC(0): V(i, 12) = PAC(1): V(i, 13) = PAC(2): V(i, 14) = gidValue: V(i, 15) = gidPart
sumResult = sumResult + Evaluate(PAC(0) & " * " & PAC(1) & " * " & PAC(2) & " * " & gidValue)
If UBound(S) = i Then Exit For
Next
For i = 1 To UBound(S): V(i, 10) = sumResult: Next
UM.Cells(InitRowUM, 1).Resize(UBound(V), UBound(V, 2)).Value = V
InitRowUM = InitRowUM + UBound(V)
sumResult = 0
End If
Next
Bordures
Else
MsgBox "Borderau non trouvé"
End If
Set UM = Nothing
Application.ScreenUpdating = True
MsgBox "Processus: " & Format$(Timer - T, "0.0000s")
End Sub