Private Function ligx(dep As String, pal As String, idx As Long) As Long
Dim numlig
numlig = Split(dictDep(dep), ",")
If idx - 1 <= UBound(numlig) Then ligx = CLng(numlig(idx - 1))
End Function
Désolé mais je ne comprends pas où dois-je l'intégrerRemplace la fonction ligx par :
ericVB:Private Function ligx(dep As String, pal As String, idx As Long) As Long Dim numlig numlig = Split(dictDep(dep), ",") If idx - 1 <= UBound(numlig) Then ligx = CLng(numlig(idx - 1)) End Function
edit 15:47 : du coup j'ai pu simplifier la fonction.
On pourrait simplifier encore en l'intégrant aux 2 précédentes fonctions. Elle n'a plus beaucoup de raison d'être.
J'ai trouvé mais ça n'a pas l'air de fonctionner :SDésolé mais je ne comprends pas où dois-je l'intégrer
Tu as vu que j'avais modifié à nouveau à 15:47 ? Prend la dernière version.
Peut-être une petite désynchronisation suite à tes manips.
Va sur la feuille DATABASE, reviens et teste à nouveau, en changeant un des paramètre pour forcer le recalcul.
Pour que la fonction soit rapide la base est chargée et les dictionaries sont initialisés à l'ouverture et à la désactivation de DATABASE (en cas de modif)
PS : je dois m'absenter
Option Explicit
Dim initBaseOk As Boolean
Dim datas, dictDep, dictPallet, dictPays
Function Forwarding(pays As String, codePostal, palette As String, index As Long)
Dim lig As Long, numlig
If Not initBaseOk Then initbase
numlig = Split(dictDep(dictPays(pays) & codePostal), ",")
If index - 1 <= UBound(numlig) Then lig = CLng(numlig(index - 1))
If lig > 0 Then Forwarding = datas(lig, 2) Else Forwarding = ""
End Function
Function cout(pays As String, codePostal, palette As String, index As Long)
Dim lig As Long, numlig
If Not initBaseOk Then initbase
numlig = Split(dictDep(dictPays(pays) & codePostal), ",")
If index - 1 <= UBound(numlig) Then lig = CLng(numlig(index - 1))
If lig > 0 Then cout = datas(lig, dictPallet(palette)) Else cout = ""
End Function
Sub initbase()
Dim lig As Long, col As Long
Set dictDep = CreateObject("Scripting.Dictionary")
Set dictPallet = CreateObject("Scripting.Dictionary")
Set dictPays = CreateObject("Scripting.Dictionary")
' dict pays
With Sheets("Liste déroulante")
datas = .[F9:F10].Resize(, .Cells(9, Columns.Count).End(xlToLeft).Column - 5).Value
End With
For col = 1 To UBound(datas, 2)
dictPays(datas(1, col)) = datas(2, col)
Next col
' datas
datas = Sheets("DATABASE").[A7].CurrentRegion.Value
' dict départements
For lig = 7 To UBound(datas)
If dictDep.exists(datas(lig, 1)) Then
dictDep(datas(lig, 1)) = dictDep(datas(lig, 1)) & "," & lig
Else
dictDep(datas(lig, 1)) = lig
End If
Next lig
' dict palettes
For col = 4 To UBound(datas, 2)
dictPallet(datas(4, col)) = col
Next col
initBaseOk = True
End Sub
Par contre j'ai un petit soucis, cela ne fonctionne pas pour l'AT10 et uniquement celle-ci. Je ne sais pas si chez vous cela fonctionne.Super super super, cela fonctionne. Mille merci.
Je fais quelques essais
' datas
datas = Sheets("DATABASE").[A6].CurrentRegion.Value
' dict départements
For lig = 6 To UBound(datas)
Bonjour,
Tu as raison. J'ai oublié de remonter tout d'une ligne après avoir supprimé la ligne 1 vide qui m'embêtait dans DATABASE.
Remplacer ces lignes dans initBase(), les 7 deviennent 6 :
ericVB:' datas datas = Sheets("DATABASE").[A6].CurrentRegion.Value ' dict départements For lig = 6 To UBound(datas)
"Review tab" c'est le menu RÉVISION sur version française.Voici les messages d'erreur que Excel affiche. Je ne trouve pas où est "change group"