Bonjour,
Pour ceux que ça intéresse, voici aussi une solution par VBA pour transformer le tableau de saisie en résultat final:
Sub transformation()
Dim tabSource As Variant, tabFinal As Variant, tabNAF As Variant
Dim nbCol As Integer, ligFin As Integer
'initialisations
tabSource = Feuil1.Range("A1").CurrentRegion.Value
ligFin = Feuil2.Range("A" & Rows.Count).End(xlUp).Row
tabNAF = Feuil2.Range("A1", "B" & ligFin).Value
nbCol = Feuil3.Cells(1, Columns.Count).End(xlToLeft).Column
ReDim tabFinal(1 To UBound(tabSource, 1) - 1, 1 To nbCol)
'remplissage du tableau
For i = LBound(tabSource, 1) + 1 To UBound(tabSource, 1)
tabFinal(i - 1, 1) = tabSource(i, 1)
tabFinal(i - 1, 2) = tabSource(i, 5)
tabFinal(i - 1, 3) = tabSource(i, 30)
tabFinal(i - 1, 4) = rechercheEtablissement(tabSource(i, 30), tabNAF)
tabFinal(i - 1, 5) = tabSource(i, 16) & tabSource(i, 22)
tabFinal(i - 1, 6) = tabSource(i, 73)
tabFinal(i - 1, 7) = IIf(tabSource(i, 41) = "", "", tabSource(i, 41) & ", ") & tabSource(i, 42) & " " & tabSource(i, 44) _
& " " & tabSource(i, 45) & ", " & tabSource(i, 46) & " " & tabSource(i, 47)
tabFinal(i - 1, 8) = WorksheetFunction.Proper(tabSource(i, 24)) & " " & tabSource(i, 22)
tabFinal(i - 1, 9) = tabSource(i, 21)
Next i
'export résultat
With Feuil3
ligFin = .Range("A" & Rows.Count).End(xlUp).Row
If ligFin > 1 Then
.Range("A2", "A" & ligFin).EntireRow.Delete
End If
.Range("A2").Resize(UBound(tabFinal, 1), nbCol).Value = tabFinal
End With
End Sub
Function rechercheEtablissement(ByVal NAF As String, tabNAF As Variant)
Dim resultat As String
NAF = LCase(NAF)
For i = LBound(tabNAF, 1) To UBound(tabNAF, 1)
If NAF = LCase(tabNAF(i, 1)) Then
resultat = tabNAF(i, 2)
Exit For
End If
Next i
rechercheEtablissement = resultat
End Function