Foutmelding

[BelgianEagle]

Ik krijg steeds een foutmelding bij de volgende formule..

'Transformation pour ajout de +1 à la cel***e
If Asc(Left(Résult, 1)) < 97 Then
                RET = (Asc(Left(Résult, 1)) - 65 + 220)
             Else
                RET = (Asc(Left(Résult, 1)) - 97 + 220)
            End If

 

[dnties]

Wellicht is RET niet als Integer gedeclareerd? (of als Variant)
Wellicht is Résult niet als een String gedeclareerd? (of als Variant)
Wellicht heeft Résult nog geen (tekenreeks-)waarde vóórdat je erop probeert te testen (zodat de Left-functie faalt)? Of verwijst Résult naar een cel waar geen tekenreekswaarde in aanwezig is?

link en link

Succes,

Tijs.

 

[BelgianEagle]

Wellicht is RET niet als Integer gedeclareerd?
Wellicht is Résult niet als een String gedeclareerd?
Wellicht heeft Résult nog geen (tekenreeks-)waarde vóórdat je erop probeert te testen (zodat de Left-functie faalt)?

link en link

Succes,

Tijs.

Geen idee, ik heb niet zoveel kaas gegeten van VBA.

Ik zit hier met een foutmelding op mijn werk. En de code die geschreven is voor de userform is belachelijk lang. Maar de probleemoplosser geeft dit altijd weer als fout.
Ik weet niet of ik die code hier zomaar op het internet mag gooien..

 

[dnties]

Je weet waar je in ieder geval naar moet gaan kijken:
a. de declaraties van RET en Résult (moeten resp. Integer en String zijn, zie ook de links uit mijn vorige posting; Variant mag ook)
b. de waardetoekening aan Résult vóór het stuk waarop getest wordt.

Meer hulp is niet mogelijk zonder de broncode te zien. En zelfs dan is het (vooral m.b.t. die waardetoekening aan Résult) nog afwachten of we kunnen afleiden waar het misloopt.

Tijs.

 

[BelgianEagle]

Je weet waar je in ieder geval naar moet gaan kijken:
a. de declaraties van RET en Résult (moeten resp. Integer en String zijn, zie ook de links uit mijn vorige posting)
b. de waardetoekening aan Résult vóór het stuk waarop getest wordt.

Meer hulp is niet mogelijk zonder de broncode te zien. En zelfs dan is het (vooral m.b.t. die waardetoekening aan Résult) nog afwachten of we kunnen afleiden waar het misloopt.

Tijs.

De VBA code is zelfs te lang om hier in te posten.

Een groter stuk uit de code:

If a + d + e = testvolume2 And caa = cdd And caa = cee And cdd = cee Then
If caaa = cddd And caaa = ceee And cddd = ceee Then
Workbooks(feuilleextract).Activate
Cells(ca, 21).Value = "A SUPPRIMER"
Cells(ca, 27).Select
selection.Copy
numéro = Cells(ca, 27).Value
Workbooks(feuillefact).Activate
Set cel***etrouvee = Range(Cells(1, Résult), Cells(lastline1, 100)).Find(numéro, LookAt:=xlWhole)
If cel***etrouvee Is Nothing Then
Range(Résult & i).Select
ActiveSheet.Paste
End If

Workbooks(feuilleextract).Activate
Cells(cd, 21).Value = "A SUPPRIMER"
Cells(cd, 27).Select
selection.Copy
numéro = Cells(cd, 27).Value
Workbooks(feuillefact).Activate
Set cel***etrouvee = Range(Cells(1, Résult), Cells(lastline1, 100)).Find(numéro, LookAt:=xlWhole)
If cel***etrouvee Is Nothing Then
If Asc(Left(Résult, 1)) < 97 Then
pop = (Asc(Left(Résult, 1)) - 65 + 2)
Else
pop = (Asc(Left(Résult, 1)) - 97 + 2)
End If
Cells(i, pop).Select
ActiveSheet.Paste
End If

Workbooks(feuilleextract).Activate
Cells(ce, 21).Value = "A SUPPRIMER"
Cells(ce, 27).Select
selection.Copy
numéro = Cells(ce, 27).Value
Workbooks(feuillefact).Activate
Set cel***etrouvee = Range(Cells(1, Résult), Cells(lastline1, 100)).Find(numéro, LookAt:=xlWhole)
If cel***etrouvee Is Nothing Then
If Asc(Left(Résult, 1)) < 97 Then
pop = (Asc(Left(Résult, 1)) - 65 + 3)
Else
pop = (Asc(Left(Résult, 1)) - 97 + 3)
End If
Cells(i, pop).Select
ActiveSheet.Paste
End If
End If
GoTo w:
End If

Dit wordt zo eens een tiental keer herhaald per variant in de userform.

Public lastline1 As Variant
Public lastline2 As Variant
Public lastline4 As Variant
Public Ref As Variant
Public fees As Variant
Public Prix As Variant
Public testvolume As Variant
Public testprix As Variant
Public teststrike As Variant
Public quantité As Variant
Public strike As Variant
Public Résult As Variant
Public Deb As Variant
Public DateD As Variant
Public Mois As Variant
Public AV As Variant
Public feuille As Variant
Public CP As Variant
Public feuillefact As Variant
Public feuilleextract As Variant
Public feuilleextract2 As Variant
Public feuilleextract3 As Variant
Public l As Variant
Public testvolume2 As Variant
Public feuillecal As Variant
Public lastline3 As Variant
Public m As Variant
Public klor As Variant
Public total As Variant
Public RET As Variant
Public marché As Variant
Public lien As Variant
Public feuilletravail As Variant
Public compteur8 As Variant
Public ref1 As Variant
Public pointage As Variant

 

[dnties]

Goed, Résult zou (als ik de code zo lees) op het moment van de foutmelding een celverwijzing moeten bevatten (bijv. "A1")
'Probleem' is dat we uit de gegeven code niet kunnen halen welke celverwijzing Résult precies heeft op het moment van dat If statement.
(O.a. daarom) weten we ook niet of in de door Résult aangegeven cel wel een (tekenreeks-)waarde staat op dat moment.

Tijs.

 

[BelgianEagle]

Goed, Résult zou (als ik de code zo lees) op het moment van de foutmelding een celverwijzing moeten bevatten (bijv. "A1")
'Probleem' is dat we uit de gegeven code niet kunnen halen welke celverwijzing Résult precies heeft op het moment van dat If statement.
(O.a. daarom) weten we ook niet of in de door Résult aangegeven cel wel een (tekenreeks-)waarde staat op dat moment.

Tijs.

Ik denk niet dat hij een celverwijzing moet bevatten, hij moet ze juist opzoeken.

Je moet eerst in de Userform invullen in welke kolom prijs staat, welke kolom hoeveelheid staat, .. etc
Dan moet je op zoeken klikken op de Userform, en dan een andere xls aanduiden en daar gaat hij dezelfde gegevens gaan vergelijken. Doet die dat, dan filtert hij deze en laat hij die jou meteen zien.

Ik had je graag een printscreen doorgestuurd, maar het werk verbiedt elke uploadvorm.

Sub passage1_1()
Dim i As Integer
Dim b_existe As Boolean
Application.ScreenUpdating = False
feuillefact = ActiveWorkbook.Name
If TextBox9 = "" Then
fichier = Application.GetOpenFilename("(*.xls),xls", , , , False)
feuilleextract = Dir(fichier)
Workbooks.Open (fichier)
lien = fichier
End If
Workbooks(feuilleextract).Activate
selection.AutoFilter Field:=3, Criteria1:="V"
Application.CutCopyMode = False
ActiveSheet.ShowAllData
lastline2 = lastline("C")
'Strike
strike = TextBox2
'Price
Prix = TextBox1
'Volume
quantité = TextBox3
'Année d'échéance
Annéefin = TextBox4
'Ligne de début
Deb = TextBox13
'Colonne des résultats --> Renvois clé primaire
Résult = TextBox12
'Référence de la facture
Ref = TextBox14
'Montant ds frais
fees = TextBox11
'Call/put
CP = TextBox5
'Date de trade
DateD = TextBox6
'Mois d'échéance
Mois = TextBox7
'Achat/Vente
AV = TextBox8
'Portefeuille
feuille = TextBox15
'marché
marché = TextBox16

'On renomme une feuille qui pourrait s'appeler facture pour éviter un bug avec le filtre avancé
Workbooks(feuillefact).Activate
For i = 1 To Sheets.Count
If Sheets(i).Name = "facture" Then
Sheets(i).Name = "Pas de nom"
End If
Next

'Transformation pour ajout de +1 à la cel***e
If Asc(Left(Résult, 1)) < 97 Then
RET = (Asc(Left(Résult, 1)) - 65 + 220)
Else
RET = (Asc(Left(Résult, 1)) - 97 + 220)
End If

'Ajout de l'ordre facture
Workbooks(feuillefact).Activate
lastline1 = lastline(Prix)
mdr = 0
For i = Deb To lastline1
mdr = mdr + 1
Cells(i, RET) = mdr
Next i

'Mise en forme optionnelle
If CheckBox12.Value = True Then
Range(Cells(Deb, Prix), Cells(lastline1, Prix)).Select
selection.Replace What:=".", Replacement:=".", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False

For i = Deb To lastline1

Cells(i, Prix) = CStr(Cells(i, Prix))

Next i

Range(Cells(Deb, strike), Cells(lastline1, strike)).Select
selection.Replace What:=".", Replacement:=".", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False

For i = Deb To lastline1

Cells(i, strike) = CDbl(Cells(i, strike))

Next i

Range(Cells(Deb, quantité), Cells(lastline1, quantité)).Select
selection.Replace What:=".", Replacement:=".", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False

For i = Deb To lastline1

Cells(i, quantité) = CDbl(Cells(i, quantité))

Next i

End If
'Fin de la mise en forme optionnelle

'ETAPE CREATION DE FICHIER AD HOC

'************Ouvrir un classeur qui va servir à rapporter chacune des références**************
If CheckBox13 = True Then
iSheets = Application.SheetsInNewWorkbook
Application.SheetsInNewWorkbook = 50
Workbooks.Add
Application.SheetsInNewWorkbook = iSheets
feuilletravail = ActiveWindow.Caption
End If

'Ajout d'un classeur provisoire pour le filtre élaboré où l'on va copier les données des extracts soit au maximum 65000 lignes
iSheets = Application.SheetsInNewWorkbook
Application.SheetsInNewWorkbook = 1
Workbooks.Add
Application.SheetsInNewWorkbook = iSheets
feuilleextract3 = ActiveWindow.Caption

Workbooks(feuilleextract).Activate
Cells.Select
selection.Copy
Workbooks(feuilleextract3).Activate
ActiveSheet.Paste


' *************************************************************************************
'Ouvrir un fichier provisoire Ad-hoc (3ème)

iSheets = Application.SheetsInNewWorkbook
Application.SheetsInNewWorkbook = 1
Workbooks.Add
Application.SheetsInNewWorkbook = iSheets

feuilleextract2 = ActiveWindow.Caption

'Range total des extracts
Workbooks(feuilleextract3).Activate
tradepriceas = Cells(1, 19)
strikeK = Cells(1, 14)
Workbooks(feuillefact).Activate
Cells(Deb - 1, Prix) = tradepriceas
Cells(Deb - 1, strike) = strikeK

'On enregistre les colone prix et strike sous variable
Range(strike & Deb - 1 & ":" & strike & lastline1).Select
selection.Copy
Cells(Deb, 70).Select
ActiveSheet.Paste
Range(Prix & Deb - 1 & ":" & Prix & lastline1).Select
selection.Copy
Cells(Deb, 71).Select
ActiveSheet.Paste

'On nomme la feuille facture pour l'utilisation du filtre avancé
ActiveSheet.Name = "facture"

'filtre avancé sur le critère Prix
Workbooks(feuilleextract3).Activate
Cells.AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=Workbooks( _
feuillefact).Sheets("facture").Range("BR" & Deb & ":BS" & lastline1 + 1), unique:=False

'On supprime pour éviter problème lors de la recherche
Workbooks(feuillefact).Activate
Range("BR" & Deb & ":BS" & lastline1 + 1).Clear


'Copier/colle de l'ensemble des résultats
Workbooks(feuilleextract3).Activate
Cells.Select
selection.EntireColumn.Hidden = False
selection.Copy
Workbooks(feuilleextract2).Activate
Range("A1").Select
ActiveSheet.Paste

'Fermer le fichier
'Pour vider le presse papier
Range("A1").Select
selection.Copy
Application.CutCopyMode = False
Workbooks(feuilleextract3).Close savechanges:=False
Workbooks(feuilleextract).Close savechanges:=False

'On permute les noms des deux extracts et ouverture à nouveau : Nécessite l'accès au réseau
feuilleextract = feuilleextract2
Workbooks(feuilleextract).Activate

' **************************************************************************************
'Boucle N°1 pour récupérer les informations de la facture
For l = Deb To lastline1
Workbooks(feuillefact).Activate

'************** La récupération des informations dépend uniquement de la triangulation renseignée dans le userform***********************

'On ne va récupérer l'information que si la colonne a été renseignée dans le userform
'Quantité
If quantité <> "" Then
testvolume = Cells(l, quantité).Value
End If

'On ne va récupérer l'information que si la colonne a été renseignée dans le userform
'Prix
If Prix <> "" Then
testprix = Cells(l, Prix).Value
End If

'Strike
If strike <> "" Then
teststrike = Cells(l, strike).Value
End If

'Echéance
If Annéefin <> "" Then
testannée = Cells(l, Annéefin).Value
End If

'Type : Call/Put
If CP <> "" Then
testcall = Cells(l, CP).Value
End If

'Trade date : Date de début de contrat
If DateD <> "" Then
testDate = Cells(l, DateD).Value
End If

'Mois d'échéance
If Mois <> "" Then
testmois = Cells(l, Mois).Value
End If

'Sens : Achat/Vente
If AV <> "" Then
testAV = Cells(l, AV).Value
End If

'On ne recherche la ligne dans les extracts que si elle n'a pas déjà été pointée : Sécurité et gain de temps
If Range(Résult & l).Value = "" Then
Workbooks(feuilleextract).Activate
Call passage1_2(testvolume, testprix, teststrike, testannée, testcall, testDate, testmois, testAV)
End If
Next l
'*****************************************************************************
'Appel du multi quantité après pose d'une référence provisoire
'*****************************************************************************
Call provisoire(Deb, Résult, feuilleextract, feuillefact)
Call multi
End Sub
Sub passage1_2(testvolume, testprix, teststrike, testannée, testcall, testDate, testmois, testAV)
Dim compteur As Variant

'*******************On va chercher dans les extracts si les critères correspondent à une ligne dans ce cas on va marquer la ligne******************
'--> ATEENTION : On ne tourne pas réellement sur les extracts mais sur le filtre qui a été réalisé précédemment, ainsi a=u lieu de 65000 ligne on tourne sur 5 % d'entre elles environs

'Mise à 0 de l'info si trouvé
result = ""
lastline4 = lastline("C")

' Passage N°1 sur les extract de la 1ère ligne à la dernière
For z = 2 To lastline4
rtestfinal = 0
rtest1 = 0
rtest2 = 0
rtest3 = 0
rtest4 = 0
rtest5 = 0
rtest6 = 0
rtest7 = 0
rtest8 = 0
rtest9 = 0

'On met le compteur sur 1 pour prendre en compte le fait que la colonne référence doit être vide afin de ne pas repointée une ligne déjà prise
compteur = 1


'On fait un primier filtre sur le prix pour permettre d'éliminer le plus rapidement possible un grand nombre de ligne
'Prix : colonne 19
If testprix <> "" Then
compteur = compteur + 1
If testprix = Cells(z, 19) Then
rtest4 = 1
Else
'Si aucun prix ne fonctionne alors on ne cherche pas les autres critère et on passe directement à la ligne suivante de la facture : Ce deal ne sera donc pas trouvé
GoTo w:
End If
End If

'Strike : Colonne 14
If teststrike <> "" Then
compteur = compteur + 1
If teststrike = Cells(z, 14) Then
rtest1 = 1
End If
End If

'Année d'échéance : Colonne 12
If testannée <> "" Then
compteur = compteur + 1
If testannée = Cells(z, 12) Then
rtest2 = 1
End If
End If

'Volume de quantité
If testvolume <> "" Then
compteur = compteur + 1
If testvolume = Cells(z, 5) Then
rtest3 = 1
End If
End If

'Type : Call/Put
If testcall <> "" Then
compteur = compteur + 1
If testcall = Cells(z, 13) Then
rtest5 = 1
End If
End If

'Date de trade
If testDate <> "" Then
compteur = compteur + 1
If testDate = Cells(z, 2) Then
rtest6 = 1
End If
End If

'Mois d'échéance
If testmois <> "" Then
compteur = compteur + 1
If testmois = Cells(z, 11) Then
rtest7 = 1
End If
End If

'Sens : Achat/Vente
If testAV <> "" Then
compteur = compteur + 1
If testAV = Cells(z, 3) Then
rtest8 = 1
End If
End If

'On recherche éventuellement le portefeuille qui a été rentré dans le userform
If feuille <> "" Then
compteur = compteur + 1
If feuille = Cells(z, 15) Then
rtest9 = 1
End If
End If

'On prend en compte si la colonne référence est vide UNIQUEMENT
If Cells(z, 21) = "" Then
rtest10 = 1
End If

'On fait un test final pour savoir combien de critère sont remplis
rtestfinal = rtest1 + rtest2 + rtest3 + rtest4 + rtest5 + rtest6 + rtest7 + rtest8 + rtest9 + rtest10 + rtest11

'Si pour chaque critère souhaité par l'utilisateur correspond un matching alors on va rentrer dans la boucle pour le flag
If rtestfinal = compteur Then

'1ère sécurité : Cherche si la clé primaire est déjà utilisée dans les colonnes résultats
numéro = Cells(z, 27).Value
Workbooks(feuillefact).Activate
Set cel***etrouvee = Range(Cells(1, Résult), Cells(lastline1, Résult)).Find(numéro, LookAt:=xlWhole)
If cel***etrouvee Is Nothing Then

'Si le numéro n'existe pas, alors on flag en important le numéro de clef primaire dans la colonne résultat (La dernière)
Workbooks(feuilleextract).Activate
primaire = Cells(z, 27).Value
Workbooks(feuillefact).Activate
Range(Résult & l) = primaire
result = "OK"

'On sort de la boucle, 1ère trouvée, 1ère ligne prise en compte
GoTo O:
End If
End If
'On met à jour la statusBar pour l'information de l'utilisateur : OK si la ligne est trouvée
Application.StatusBar = " Nber ligne Facture: " & l - Deb + 1 & " / " & lastline1 - Deb + 1 & " Nber ligne Extract: " & z & " Resultat : " & result
Workbooks(feuilleextract).Activate
w:
'On boucle jusqu'à la fin de l'extracts "filtré"
Next z
O:
Application.StatusBar = " Nber ligne Facture: " & l - Deb + 1 & " / " & lastline1 - Deb + 1 & " Nber ligne Extract: " & z & " Resultat : " & result

'On récative la facture pour chercher une autre ligne
Workbooks(feuillefact).Activate
End Sub
Function lastline(col)
'On va chercher la dernière ligne de feuille
Range(col & 65536).Select
selection.End(xlUp).Select
lastline = ActiveCell.Row

End Function
Sub Rf(Deb, Résult, feuilleextract, feuillefact)
'Application des références correspondante à la ligne
Workbooks(feuillefact).Activate

'On crée une boucle pour recherche les lignes qui ont été pointées
For i = Deb To lastline1
'Si la ligne i n'est pas vide alors on rentre dans la boucle
If Not IsEmpty(Range(Résult & i)) Then
'On va retenir certains critères : La valeur de la clef primaire, la référence associé à ce numéro de clef, la référence pour l'aide au pointage
testmarque = Cells(i, Résult)
référence = Cells(i, Ref)
pointage = Cells(i, RET)
'On bascule sur les extracts pour chercher la ligne avec cette référence
Workbooks(feuilleextract).Activate
Call rf_part2(testmarque, feuillefact, lastline2, Résult, i, pointage, référence)
End If
Next i
End Sub

Sub rf_part2(testmarque, feuillefact, lastline2, Résult, i, pointage, référence)

'On sait que le N° de clef primaire doit forcément être trouvé et qu'il existe une relation entre ce N° et le numéro de ligne, on va ainsi faire démarrer la recherche au point stratégique P-1
For z = testmarque To lastline2
rtestfinal = 0
rtestmarque = 0

'Quand le test match alors on entre dans la boucle
If testmarque = Cells(z, 27) Then

'Sécurité N°2 : On entre que si la cells est vide ou contient le flag provisoire
If Cells(z, 21) = "" Or Cells(z, 21) = "A SUPPRIMER" Then
'On met la référence comprise dans le userform
'On ajoute la référence, le N° d'aide au pointage
'Dans la dernière colonne on ajoute "AUTO RECON" pour la réalisation de stat
Cells(z, 21).Value = référence
Cells(z, 24).Value = pointage
Cells(z, 256).Value = "AUTO RECON"
Workbooks(feuillefact).Activate
'Lorsque la ligne a été trouvé on sort de la boucle, aucun intérêt de continuer
GoTo j:
Else
Workbooks(feuillefact).Activate
Cells(i, Résult).Clear
GoTo j:
End If
End If

'On met à jour l'information
Application.StatusBar = " Nber ligne Facture: " & i - Deb + 1 & " Traitement en cours...Ajout des références...Patientez... "

Next z

'Point de sortie
j:
End Sub

 

[BelgianEagle]

Vervolg 2/5 van de code.

Sub CTG(Deb, Résult, feuilleextract, feuillefact, testmarque1)
'Même cas que pour les références, on va ajouter les courtages
Workbooks(feuillefact).Activate
For i = Deb To lastline1
Workbooks(feuillefact).Activate
If Not IsEmpty(Cells(i, Résult)) Then
testmarque4 = Cells(i, Résult)
Workbooks(feuilleextract).Activate

'On entre dans la deuxième boucle
Call CTG2(testmarque4, feuillefact, feuilleextract, lastline2, Résult, i, fees)
End If
Application.StatusBar = " Ajout des courtages position actuelle : " & i - Deb + 1

Next i
'Opération terminé pour les deals non éclaté, avec Référence + courtage
'***************************************************************************
'Etape N°2 : Combos multi-lignes
'***************************************************************************
End Sub

Sub CTG2(testmarque4, feuillefact, feuilleextract, lastline2, Résult, i, fees)
'Début de la deuxième boucle, on débute au numéro de ligne -1 par rapport à la position ce qui accélère le traitement
For z = testmarque4 To lastline2
'Remise à 0 des valeurs
rtestfinal2 = 0
rtestmarque4 = 0
valeur = ""
'On va chercher le N° de clé primaire jusqu'à le trouver
If testmarque4 = Cells(z, 27) Then
If Cells(z, 20) = "" Then
'Une fois la clé trouvée, on peut passer sur l'extract pour ajouter le courtage correspondant
Workbooks(feuillefact).Activate
valeur = Cells(i, fees)
Workbooks(feuilleextract).Activate
Cells(z, 20).Value = valeur
Workbooks(feuillefact).Activate
GoTo x:
End If
End If
Next z
x:
Workbooks(feuillefact).Activate
End Sub
Sub multi()

'**********************************************************************************
'On va procéder au regroupement par quantité (6 Combinaisons maximum)
'**********************************************************************************
Dim testvolume As Variant
Dim testprix As Variant
Dim teststrike As Variant
Dim testAV As Variant
Workbooks(feuillefact).Activate
For i = Deb To lastline1
a = ""
b = ""
c = ""
d = ""
e = ""
f = ""
'On repère les valeurs à comparer (Prix, strike...)
Workbooks(feuillefact).Activate
testvolume2 = Cells(i, quantité).Value
testprix = Cells(i, Prix).Value
teststrike = Cells(i, strike).Value
'Si la valeur la colonne résultat est vide alors on entre dans la boucle pour essayer de combiner
If Range(Résult & i).Value = "" Then
Workbooks(feuilleextract).Activate

Call multi_2(i, lastline2, testprix, testvolume, teststrike, testcp, rtestfinal, feuillefact, feuilleextract, strike, Prix, quantité, Annéefin, Deb, Résult, CP, DateD, Mois, AV, testcall, testDate, testmois, testAV)
End If

Next i
'******************************************************************************
'Mise en place des références + courtage pour les MIX
'******************************************************************************
feuilleextract2 = feuilleextract
feuilleextract = Dir(lien)
Workbooks.Open (lien)
feuilleextract = ActiveWindow.Caption
'Une fois l'opération réalisée on va pouvoir ajouter les courtages et références UNIQUEMENT pour les lignes trouvées par les combinaisons
Call Rf(Deb, Résult, feuilleextract, feuillefact)
Call CTG(Deb, Résult, feuilleextract, feuillefact, testmarque1)
Call Rf2(Deb, Résult, feuilleextract, feuillefact)
'Le sub comptage permet de réaliser des stats et passer à des étapes supplémentaires
Call comptage(feuillefact, Résult, Prix, Deb)
End Sub
Sub multi_2(i, lastline2, testprix, testvolume, teststrike, testcp, rtestfinal, feuillefact, feuilleextract, strike, Prix, quantité, Annéefin, Deb, Résult, CP, DateD, Mois, AV, testcall, testDate, testmois, testAV)
Workbooks(feuilleextract).Activate

Dim compteur2 As Variant

For z = 2 To lastline4

volume1 = 0
rtest1 = 0
rtest4 = 0
rtest5 = 0
rtest6 = 0

'Si le prix match alors on continue à comparer les critères
If testprix = Cells(z, 19) Then
rtest5 = 1
Else
'Point de sortie en cas d'échec
GoTo c:
End If

If teststrike = Cells(z, 14) Then
rtest1 = 1
End If

If Cells(z, 21) = "" Then
rtest6 = 1
End If

If rtest5 + rtest1 + rtest6 = 3 Then
volume1 = Cells(z, 5)
'Si une ligne correspond au strike et prix recherché alors on va stocké la quantité dans une variable
Call multi_3(i, volume1, a, b, c, d, e, z, ca, cb, cc, cd, ce, caa, cbb, ccc, cdd, cee, f, cf, cff, caaa, cbbb, cccc, cddd, ceee, cfff)
End If
c:
Next z
Workbooks(feuillefact).Activate
Call mix(i, volume1, a, b, c, d, e, z, ca, cb, cc, cd, ce, caa, cbb, ccc, cdd, cee, f, cf, cff, caaa, cbbb, cccc, cddd, ceee, cfff)
End Sub
Sub multi_3(i, volume1, a, b, c, d, e, z, ca, cb, cc, cd, ce, caa, cbb, ccc, cdd, cee, f, cf, cff, caaa, cbbb, cccc, cddd, ceee, cfff)
'Sub servant à stocker les quantités éligibles pour les combinaisons

'si la variable a n'est pas vide alors on lui attribue la valeur "quantité" trouvée
If a = "" Then
'a est donc = au volume retenu
a = volume1
'on retient le numéro de clé primaire pour ensuite la rappatrier dans le fichier facture
ca = z
'On ajoute la valeur du portefeuille afin de vérifier ultérieurement que l'ensemble des lignes regroupées impacte le même portefeuille
caa = Cells(z, 15)
'De même on retient le sens du deals pour éviter le mélnage A/V si l'utilisateur ne le choisi pas comme critère précédemment
caaa = Cells(z, 3)
GoTo y:
End If
If b = "" Then
b = volume1
cb = z
cbb = Cells(z, 15)
cbbb = Cells(z, 3)
GoTo y:
End If
If c = "" Then
c = volume1
cc = z
ccc = Cells(z, 15)
cccc = Cells(z, 3)
GoTo y:
End If
If d = "" Then
d = volume1
cd = z
cdd = Cells(z, 15)
cddd = Cells(z, 3)
GoTo y:
End If
If e = "" Then
e = volume1
ce = z
cee = Cells(z, 15)
ceee = Cells(z, 3)
GoTo y:
End If
If f = "" Then
f = volume1
cf = z
cff = Cells(z, 15)
cfff = Cells(z, 3)
GoTo y:
End If
y:
End Sub
Sub mix(i, volume1, a, b, c, d, e, z, ca, cb, cc, cd, ce, caa, cbb, ccc, cdd, cee, f, cf, cff, caaa, cbbb, cccc, cddd, ceee, cfff)
'******************************************************************************************************
'MIX = Combinaisons avec les quantités retenues en variable précédemment : Méthode empirique
'******************************************************************************************************

'Si la quantité a + la quantité b = la quantité recherchée dans la facture alors on test le sens puis le portefeuille, si tout est OK on rentre dans la boucle
If a + b = testvolume2 And caa = cbb Then
If caaa = cbbb Then
'On met une référence provisoire pour bloquer la ligne
Workbooks(feuilleextract).Activate
Cells(ca, 21).Value = "A SUPPRIMER"
' On rappatrie la clé primaire pour l'ensemble des lignes concernées dans les extracts, ici A+B donc deux N°
Cells(ca, 27).Select
selection.Copy
numéro = Cells(ca, 27).Value
Workbooks(feuillefact).Activate
Set cel***etrouvee = Range(Cells(1, Résult), Cells(lastline1, 100)).Find(numéro, LookAt:=xlWhole)
If cel***etrouvee Is Nothing Then
Range(Résult & i).Select
ActiveSheet.Paste
End If
Workbooks(feuilleextract).Activate
Cells(cb, 21).Value = "A SUPPRIMER"
Cells(cb, 27).Select
selection.Copy
numéro = Cells(cb, 27).Value
Workbooks(feuillefact).Activate
Set cel***etrouvee = Range(Cells(1, Résult), Cells(lastline1, 100)).Find(numéro, LookAt:=xlWhole)
If cel***etrouvee Is Nothing Then
'Permet le décalage d'une colonne pour chaque quantité éclatée : éclaté en 2, 2 colonnes, éclaté en 3, 3 colonne...Suite L + 1
If Asc(Left(Résult, 1)) < 97 Then
pop = (Asc(Left(Résult, 1)) - 65 + 2)
Else
pop = (Asc(Left(Résult, 1)) - 97 + 2)
End If
Cells(i, pop).Select
ActiveSheet.Paste
End If
End If
'une fois que le regroupement à pu avoir lieu, on sort de la boucle pour éviter les doublons
GoTo w:

End If
'On continue avec une autre combinaison potentielle
If a + c = testvolume2 And caa = ccc Then
If caaa = cccc Then
Workbooks(feuilleextract).Activate
Cells(ca, 21).Value = "A SUPPRIMER"
Cells(ca, 27).Select
selection.Copy
numéro = Cells(ca, 27).Value
Workbooks(feuillefact).Activate
Set cel***etrouvee = Range(Cells(1, Résult), Cells(lastline1, 100)).Find(numéro, LookAt:=xlWhole)
If cel***etrouvee Is Nothing Then
Workbooks(feuillefact).Activate
Range(Résult & i).Select
ActiveSheet.Paste
End If

Workbooks(feuilleextract).Activate
Cells(cc, 21).Value = "A SUPPRIMER"
Cells(cc, 27).Select
selection.Copy
numéro = Cells(cc, 27).Value
Workbooks(feuillefact).Activate
Set cel***etrouvee = Range(Cells(1, Résult), Cells(lastline1, 100)).Find(numéro, LookAt:=xlWhole)
If cel***etrouvee Is Nothing Then
Workbooks(feuillefact).Activate
If Asc(Left(Résult, 1)) < 97 Then
pop = (Asc(Left(Résult, 1)) - 65 + 2)
Else
pop = (Asc(Left(Résult, 1)) - 97 + 2)
End If
Cells(i, pop).Select
ActiveSheet.Paste
End If
End If
GoTo w:
End If

If a + d = testvolume2 And caa = cdd Then
If caaa = cddd Then
Workbooks(feuilleextract).Activate
Cells(ca, 21).Value = "A SUPPRIMER"
Cells(ca, 27).Select
selection.Copy
numéro = Cells(ca, 27).Value
Workbooks(feuillefact).Activate
Set cel***etrouvee = Range(Cells(1, Résult), Cells(lastline1, 100)).Find(numéro, LookAt:=xlWhole)
If cel***etrouvee Is Nothing Then
Range(Résult & i).Select
ActiveSheet.Paste
End If

Workbooks(feuilleextract).Activate
Cells(cd, 21).Value = "A SUPPRIMER"
Cells(cd, 27).Select
selection.Copy
numéro = Cells(cd, 27).Value
Workbooks(feuillefact).Activate
Set cel***etrouvee = Range(Cells(1, Résult), Cells(lastline1, 100)).Find(numéro, LookAt:=xlWhole)
If cel***etrouvee Is Nothing Then
If Asc(Left(Résult, 1)) < 97 Then
pop = (Asc(Left(Résult, 1)) - 65 + 2)
Else
pop = (Asc(Left(Résult, 1)) - 97 + 2)
End If
Cells(i, pop).Select
ActiveSheet.Paste
End If
End If
GoTo w:

 

[BelgianEagle]

Dan herhaalt het laatste zich per variant:

Public lastline1 As Variant
Public lastline2 As Variant
Public lastline4 As Variant
Public Ref As Variant
Public fees As Variant
Public Prix As Variant
Public testvolume As Variant
Public testprix As Variant
Public teststrike As Variant
Public quantité As Variant
Public strike As Variant
Public Résult As Variant
Public Deb As Variant
Public DateD As Variant
.... enzovoort

****

w:
Application.StatusBar = " Deuxième passage en cours... Réconciliation avec éclatement des quantités...Patientez "

End Sub

Sub Rf2(Deb, Résult, feuilleextract, feuillefact)
Workbooks(feuillefact).Activate
'Référence pour les nouvelles lignes trouvées
For i = Deb To lastline1
If Asc(Left(Résult, 1)) < 97 Then
pop = (Asc(Left(Résult, 1)) - 65 + 2)
Else
pop = (Asc(Left(Résult, 1)) - 97 + 2)
End If
'Point d'impact
If Not IsEmpty(Cells(i, pop)) Then
testmarque2 = Cells(i, pop)
référence = Cells(i, Ref)
Workbooks(feuilleextract).Activate
Call g2(testmarque2, feuillefact, lastline2, Résult, i, pop, référence)
End If

Next i
Call Rf3(Deb, Résult, feuilleextract, feuillefact)
End Sub

Sub g2(testmarque2, feuillefact, lastline2, Résult, i, pop, référence)
'Référence pour les nouvelles lignes trouvées, bouocle N°2 comme vu à l'étape N°1

For z = testmarque2 To lastline2
rtestfinal = 0
rtestmarque2 = 0

If testmarque2 = Cells(z, 27) Then
rtestmarque2 = 1
End If

rtestfinal2 = rtestmarque2

If rtestfinal2 = 1 Then
If Cells(z, 21) = "" Or Cells(z, 21) = "A SUPPRIMER" Then
Cells(z, 21).Value = référence
Cells(z, 256).Value = "AUTO RECON"
Workbooks(feuillefact).Activate
GoTo k:
Else
Workbooks(feuillefact).Activate
Cells(i, pop).Clear
Range(Cells(i, Résult), Cells(i, 200)).Clear
End If
End If
Next z
k:
End Sub

Sub Rf3(Deb, Résult, feuilleextract, feuillefact)
Workbooks(feuillefact).Activate
'Référence pour les nouvelles lignes trouvées : On attribue sur la colonne 3 soit Résultat + 2 avec la même logique
For i = Deb To lastline1
If Asc(Left(Résult, 1)) < 97 Then
pop = (Asc(Left(Résult, 1)) - 65 + 3)
Else
pop = (Asc(Left(Résult, 1)) - 97 + 3)
End If
If Not IsEmpty(Cells(i, pop)) Then
testmarque3 = Cells(i, pop)
référence = Cells(i, Ref)
Workbooks(feuilleextract).Activate
Call g3(testmarque3, feuillefact, lastline2, Résult, i, pop, référence)
End If
Next i
Call Rf4(Deb, Résult, feuilleextract, feuillefact)
End Sub

Sub g3(testmarque3, feuillefact, lastline2, Résult, i, pop, référence)

For z = testmarque3 To lastline2
rtestfinal2 = 0
rtestmarque3 = 0

If testmarque3 = Cells(z, 27) Then
rtestmarque3 = 1
End If

rtestfinal2 = rtestmarque3

If rtestfinal2 = 1 Then
If Cells(z, 21) = "" Or Cells(z, 21) = "A SUPPRIMER" Then
Cells(z, 21).Value = référence
Cells(z, 256).Value = "AUTO RECON"
Workbooks(feuillefact).Activate
GoTo l:
Else
Workbooks(feuillefact).Activate
Cells(i, pop).Clear
Range(Cells(i, Résult), Cells(i, 200)).Clear
End If
End If
Next z
l:
End Sub

Sub Rf4(Deb, Résult, feuilleextract, feuillefact)
Workbooks(feuillefact).Activate

For i = Deb To lastline1
If Asc(Left(Résult, 1)) < 97 Then
pop = (Asc(Left(Résult, 1)) - 65 + 4)
Else
pop = (Asc(Left(Résult, 1)) - 97 + 4)
End If
If Not IsEmpty(Cells(i, pop)) Then
testmarque4 = Cells(i, pop)
référence = Cells(i, Ref)
Workbooks(feuilleextract).Activate
Call g4(testmarque4, feuillefact, lastline2, Résult, i, pop, référence)
End If
Next i
Call Rf5(Deb, Résult, feuilleextract, feuillefact)
End Sub

Sub g4(testmarque4, feuillefact, lastline2, Résult, i, pop, référence)

For z = testmarque4 To lastline2
rtestfinal2 = 0
rtestmarque4 = 0

If testmarque4 = Cells(z, 27) Then
rtestmarque4 = 1
End If

rtestfinal2 = rtestmarque4

If rtestfinal2 = 1 Then
If Cells(z, 21) = "" Or Cells(z, 21) = "A SUPPRIMER" Then
Cells(z, 21).Value = référence
Cells(z, 256).Value = "AUTO RECON"
Workbooks(feuillefact).Activate
GoTo l:
Else
Workbooks(feuillefact).Activate
Cells(i, pop).Clear
Range(Cells(i, Résult), Cells(i, 200)).Clear
End If
End If
Next z
l:
End Sub

Sub Rf5(Deb, Résult, feuilleextract, feuillefact)
Workbooks(feuillefact).Activate

For i = Deb To lastline1
If Asc(Left(Résult, 1)) < 97 Then
pop = (Asc(Left(Résult, 1)) - 65 + 5)
Else
pop = (Asc(Left(Résult, 1)) - 97 + 5)
End If
If Not IsEmpty(Cells(i, pop)) Then
testmarque5 = Cells(i, pop)
référence = Cells(i, Ref)
Workbooks(feuilleextract).Activate
Call g5(testmarque5, feuillefact, lastline2, Résult, i, pop, référence)
End If
Next i
Call Rf6(Deb, Résult, feuilleextract, feuillefact)
End Sub

Sub g5(testmarque5, feuillefact, lastline2, Résult, i, pop, référence)

For z = testmarque5 To lastline2
rtestfinal2 = 0
rtestmarque5 = 0

If testmarque5 = Cells(z, 27) Then
rtestmarque5 = 1
End If

rtestfinal2 = rtestmarque5

If rtestfinal2 = 1 Then
If Cells(z, 21) = "" Or Cells(z, 21) = "A SUPPRIMER" Then
Cells(z, 21).Value = référence
Cells(z, 256).Value = "AUTO RECON"
Workbooks(feuillefact).Activate
GoTo l:
Else
Workbooks(feuillefact).Activate
Cells(i, pop).Clear
Range(Cells(i, Résult), Cells(i, 200)).Clear
End If
End If
Next z
l:
End Sub
Public Function FileExists(strfile As String) As Boolean

If Dir(strfile) = "" Then
FileExist = False
Else
FileExist = True
End If

End Function
Sub comptage(feuillefact, Résult, Prix, Deb)
Dim run As Variant
Dim nom_de_la_facture As String
'Pour référencer la facture
'A activer pour aide au pointage
'Call aidepointage
Workbooks(feuilleextract2).Close savechanges:=False
Workbooks(feuillefact).Activate
nom_de_la_facture = Cells(Deb, Ref)
n = 0
For Each Cell In Range(Cells(Deb, Résult), Cells(65500, Résult))
'Workbooks(feuillefact).Column (Résult)
If Not IsEmpty(Cell) Then n = n + 1
Next Cell
m = 0
For Each Cell In Range(Cells(Deb, Prix), Cells(65500, Prix))
If Not IsEmpty(Cell) Then m = m + 1
Next Cell
Application.StatusBar = " Traitement terminé "
MsgBox ("Nombre de lignes traitées : " & m) + Chr(13) + ("Nombre de lignes trouvées : " & n) + Chr(13) + ("Pourcentage de lignes trouvées : " & n / m * 100 & " %") + Chr(13) + ("Traitement terminé, vous pouvez quitter")

'Ajout au fichier Stats avec les deux possibilité en fonction de l'ordinateur

Workbooks.Open filename:="F:\BusinessData\CIB_SSCFees\Stats macro AUTO"

stat = ActiveWindow.Caption
lastline3 = lastline("E")
Cells(lastline3 + 1, "A").Value = nom_de_la_facture
Cells(lastline3 + 1, "E").Value = m
Cells(lastline3 + 1, "F").Value = n
Cells(lastline3 + 1, "C").Value = feuilleextract
Cells(lastline3 + 1, "D").Value = Date
Workbooks("Stats macro AUTO.xls").Close savechanges:=True
Workbooks(feuillefact).Activate

Application.StatusBar = ""

'*******Permettre d'aller vers la feuille de travail***********
If CheckBox13 = True Then
Call travail
End If
Application.ScreenUpdating = True
End
End Sub

Sub aidepointage()
'******************************************************************************************************************************
'On va ajouter un N° qui permet de conserver l'ordre de la facture, ainsi on retrouvera plus facilement les stratégies
'******************************************************************************************************************************
Workbooks(feuillefact).Activate

For i = Deb To lastline1
If Not IsEmpty(Range(Résult & i)) Then
testaide = Cells(i, Résult)
pointage = Cells(i, RET)

Workbooks(feuilleextract).Activate
Call rf_part34(testaide, feuillefact, lastline2, Résult, i, pointage)
End If
Next i
Call Rf2bis(Deb, Résult, feuilleextract, feuillefact)
End Sub

Sub rf_part34(testaide, feuillefact, lastline2, Résult, i, pointage)

For z = 2 To lastline2
rtestfinal2 = 0
rtestmarque = 0

If testaide = Cells(z, 27) Then
Cells(z, 24).Value = pointage
Workbooks(feuillefact).Activate
GoTo j:
End If

Application.StatusBar = " Nber ligne Facture: " & i - Deb + 1 & " Traitement en cours...Ajout des aides au pointage...Patientez... "

Next z
j:
End Sub
Sub Rf2bis(Deb, Résult, feuilleextract, feuillefact)
Workbooks(feuillefact).Activate

For i = Deb To lastline1
If Asc(Left(Résult, 1)) < 97 Then
pop = (Asc(Left(Résult, 1)) - 65 + 2)
Else
pop = (Asc(Left(Résult, 1)) - 97 + 2)
End If
'Point d'impact
If Not IsEmpty(Cells(i, pop)) Then
testaide = Cells(i, pop)
pointage = Cells(i, RET)
Workbooks(feuilleextract).Activate
Call g2bis(testaide, feuillefact, lastline2, Résult, i, pop, pointage)
End If

Next i
Call Rf3bis(Deb, Résult, feuilleextract, feuillefact)
End Sub

Sub g2bis(testaide, feuillefact, lastline2, Résult, i, pop, pointage)

For z = testaide To lastline2
rtestfinal2 = 0
rtestmarque = 0

If testaide = Cells(z, 27) Then
rtestaide = 1
End If

rtestfinal2 = rtestaide

If rtestfinal2 = 1 Then
Cells(z, 24).Value = pointage
Workbooks(feuillefact).Activate
GoTo j:
End If

Application.StatusBar = " Nber ligne Facture: " & i - Deb + 1 & " Traitement en cours...Ajout des aides au pointage...Patientez... "

Next z
j:
End Sub
Sub Rf3bis(Deb, Résult, feuilleextract, feuillefact)
Workbooks(feuillefact).Activate

For i = Deb To lastline1
If Asc(Left(Résult, 1)) < 97 Then
pop = (Asc(Left(Résult, 1)) - 65 + 3)
Else
pop = (Asc(Left(Résult, 1)) - 97 + 3)
End If
'Point d'impact
If Not IsEmpty(Cells(i, pop)) Then
testaide = Cells(i, pop)
pointage = Cells(i, RET)
Workbooks(feuilleextract).Activate
Call g3bis(testaide, feuillefact, lastline2, Résult, i, pop, pointage)
End If

Next i
Call Rf4bis(Deb, Résult, feuilleextract, feuillefact)
End Sub

Sub g3bis(testaide, feuillefact, lastline2, Résult, i, pop, pointage)

For z = testaide To lastline2
rtestfinal2 = 0
rtestmarque = 0

If testaide = Cells(z, 27) Then
rtestaide = 1
End If

rtestfinal2 = rtestaide

If rtestfinal2 = 1 Then
Cells(z, 24).Value = pointage
Workbooks(feuillefact).Activate
GoTo j:
End If

Application.StatusBar = " Nber ligne Facture: " & i - Deb + 1 & " Traitement en cours...Ajout des aides au pointage...Patientez... "

Next z
j:
End Sub
Sub Rf4bis(Deb, Résult, feuilleextract, feuillefact)
Workbooks(feuillefact).Activate

For i = Deb To lastline1
If Asc(Left(Résult, 1)) < 97 Then
pop = (Asc(Left(Résult, 1)) - 65 + 4)
Else
pop = (Asc(Left(Résult, 1)) - 97 + 4)
End If
'Point d'impact
If Not IsEmpty(Cells(i, pop)) Then
testaide = Cells(i, pop)
pointage = Cells(i, RET)
Workbooks(feuilleextract).Activate
Call g4bis(testaide, feuillefact, lastline2, Résult, i, pop, pointage)
End If

Next i
Call Rf5bis(Deb, Résult, feuilleextract, feuillefact)
End Sub

Sub g4bis(testaide, feuillefact, lastline2, Résult, i, pop, pointage)

For z = testaide To lastline2
rtestfinal2 = 0
rtestmarque = 0

If testaide = Cells(z, 27) Then
rtestaide = 1
End If

rtestfinal2 = rtestaide

If rtestfinal2 = 1 Then
Cells(z, 24).Value = pointage
Workbooks(feuillefact).Activate
GoTo j:
End If

Application.StatusBar = " Nber ligne Facture: " & i - Deb + 1 & " Traitement en cours...Ajout des aides au pointage...Patientez... "

Next z
j:
End Sub
Sub Rf5bis(Deb, Résult, feuilleextract, feuillefact)
Workbooks(feuillefact).Activate

For i = Deb To lastline1
If Asc(Left(Résult, 1)) < 97 Then
pop = (Asc(Left(Résult, 1)) - 65 + 5)
Else
pop = (Asc(Left(Résult, 1)) - 97 + 5)
End If
'Point d'impact
If Not IsEmpty(Cells(i, pop)) Then
testaide = Cells(i, pop)
pointage = Cells(i, RET)
Workbooks(feuilleextract).Activate
Call g5bis(testaide, feuillefact, lastline2, Résult, i, pop, pointage)
End If

Next i
End Sub

Sub g5bis(testaide, feuillefact, lastline2, Résult, i, pop, pointage)

For z = testaide To lastline2
rtestfinal2 = 0
rtestmarque = 0

If testaide = Cells(z, 27) Then
rtestaide = 1
End If

rtestfinal2 = rtestaide

If rtestfinal2 = 1 Then
Cells(z, 24).Value = pointage
Workbooks(feuillefact).Activate
GoTo j:
End If

Application.StatusBar = " Nber ligne Facture: " & i - Deb + 1 & " Traitement en cours...Ajout des aides au pointage...Patientez... "

Next z
j:
End Sub
Sub provisoire(Deb, Résult, feuilleextract, feuillefact)
Workbooks(feuillefact).Activate

For i = Deb To lastline1
If Not IsEmpty(Range(Résult & i)) Then
testmarque = Cells(i, Résult)
Workbooks(feuilleextract).Activate
Call rf_part21(testmarque, feuillefact, lastline2, Résult, i, pointage)
End If
Next i
End Sub

Sub rf_part21(testmarque, feuillefact, lastline2, Résult, i, pointage)
Workbooks(feuilleextract).Activate
lastline3 = lastline("C")

For z = 2 To lastline3
rtestfinal = 0
rtestmarque = 0

If testmarque = Cells(z, 27) Then
If Cells(z, 21) = "" Then
Cells(z, 21).Value = "A SUPPRIMER"
Workbooks(feuillefact).Activate
GoTo j:
End If
End If

Application.StatusBar = " Nber ligne Facture: " & i - Deb + 1 & " Traitement en cours...Ajout des références provisoire...Patientez... "
'Workbooks(feuillefact).Activate
Next z
j:
Workbooks(feuillefact).Activate
End Sub

Sub Rf6(Deb, Résult, feuilleextract, feuillefact)
Workbooks(feuillefact).Activate

For i = Deb To lastline1
If Asc(Left(Résult, 1)) < 97 Then
pop = (Asc(Left(Résult, 1)) - 65 + 6)
Else
pop = (Asc(Left(Résult, 1)) - 97 + 6)
End If
If Not IsEmpty(Cells(i, pop)) Then
testmarque6 = Cells(i, pop)
référence = Cells(i, Ref)
Workbooks(feuilleextract).Activate
Call g6(testmarque6, feuillefact, lastline2, Résult, i, pop, référence)
End If
Next i
End Sub

Sub g6(testmarque6, feuillefact, lastline2, Résult, i, pop, référence)

For z = testmarque6 To lastline2
rtestfinal2 = 0
rtestmarque6 = 0

If testmarque6 = Cells(z, 27) Then

If Cells(z, 21) = "" Or Cells(z, 21) = "A SUPPRIMER" Then
Cells(z, 21).Value = référence
Cells(z, 256).Value = "AUTO RECON"
Workbooks(feuillefact).Activate

End If
End If
Next z

End Sub

Sub travail()
Dim onglet As Worksheet
'On ajoute un classeur pour exporter les références à rechercher

iSheets = Application.SheetsInNewWorkbook
Application.SheetsInNewWorkbook = 1
Workbooks.Add
Application.SheetsInNewWorkbook = iSheets
feuilletravail2 = ActiveWindow.Caption

'On copie les référence sur une feuille provisoire
Workbooks(feuillefact).Activate
Cells.Select
selection.Copy
Workbooks(feuilletravail2).Activate
Range("A1").Select
ActiveSheet.Paste

Macel***e = Ref & Deb
Range(Macel***e).Select
ActiveCell.CurrentRegion.Sort Key1:=Range(Macel***e), Order1:=xlAscending, Header:=xlYes
donnee1 = ActiveCell
ActiveCell.Offset(1, 0).Select
While ActiveCell <> ""
If ActiveCell = donnee1 Then
ActiveCell.EntireRow.Delete
ActiveCell.Offset(-1, 0).Select
donnee1 = ActiveCell
ActiveCell.Offset(1, 0).Select
Else
donnee1 = ActiveCell
ActiveCell.Offset(1, 0).Select
End If
Wend

'On recherche les Ref dans la nouvelle feuille
lastline8 = lastline(strike)
For i = Deb To lastline8
Workbooks(feuilletravail2).Activate
If Cells(i, Ref) <> "" Then
'If Cells(i, Résult) <> "" Then
ref1 = Cells(i, Ref)
Call travail2(feuilletravail2, ref1)
'End If
End If
Application.StatusBar = " Actuelle position des références sur la feuille travail: " & i - Deb + 1 & "/" & lastline8
Next i
Call manque(feuilletravail2, feuilletravail, ref1)
Workbooks(feuilletravail2).Close savechanges:=False
Workbooks(feuilletravail).Activate
For Each onglet In Worksheets
onglet.Select
If ActiveSheet.Name Like "*Feuil*" Then
Application.DisplayAlerts = False
ActiveWindow.SelectedSheets.Delete
Application.DisplayAlerts = True
End If
Call MEF_cal
Next onglet
Workbooks(feuilletravail).Activate
Sheets(1).Activate
MsgBox ("Opération terminée, si vous avez activés les calculs AUTO, ces derniers vont démarrer sinon vous pouvez quitter")
If CheckBox14 = True Then
MsgBox ("En construction...")
'Call calcul_AUTO
End If
End Sub

Sub travail2(feuilletravail2, ref1)

Workbooks(feuilleextract).Activate
lastline6 = lastline("C")
Cells(1, 1).EntireRow.Select
selection.Copy
Workbooks(feuilletravail).Activate
ActiveSheet.Paste
Workbooks(feuilleextract).Activate
'On efface le filtre
selection.AutoFilter Field:=3, Criteria1:="V"
Application.CutCopyMode = False
ActiveSheet.ShowAllData
For z = 2 To lastline6
Workbooks(feuilleextract).Activate
If Cells(z, 21) = ref1 Then
Cells(z, 21).EntireRow.Select
selection.Copy
Workbooks(feuilletravail).Activate
lastlineH = lastline("A")
Cells(lastlineH + 1, 1).Select
ActiveSheet.Paste
Workbooks(feuilleextract).Activate
End If
If z = lastline6 Then
Workbooks(feuilletravail).Activate
ActiveSheet.Name = ref1
ActiveSheet.Next.Select
End If
Next z

End Sub

Sub MEF_cal()
'*******Mettre en forme la feuille de calcul******
If Range("A1") <> "" Then
If Range("V1") <> "Taux" Then
Columns("AM:IV").Select
selection.Clear
Columns("C:C").ColumnWidth = 2.71
Columns("D").ColumnWidth = 7
Columns("E:E").ColumnWidth = 6.71
Columns("D").Select
selection.EntireColumn.Hidden = True
Columns("I:I").ColumnWidth = 3.14
Columns("H:H").ColumnWidth = 18.57
Columns("J:J").ColumnWidth = 4.71
Columns("K:K").ColumnWidth = 5
Columns("L:L").ColumnWidth = 5.86
Columns("M:M").ColumnWidth = 2.43
Columns("N:N").ColumnWidth = 5.86
Columns("O:O").ColumnWidth = 8.71
Columns("P").Select
selection.EntireColumn.Hidden = True
Columns("Q:Q").Select
selection.EntireColumn.Hidden = True
Columns("S:S").ColumnWidth = 6.57
Columns("T:T").ColumnWidth = 8
Columns("U:U").Select
Application.CutCopyMode = False
selection.Delete Shift:=xlToLeft
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 4
Columns("W:AB").Select
selection.ClearContents
Columns("V:V").Select
selection.Insert Shift:=xlToRight
Range("V1").Select
ActiveCell.FormulaR1C1 = "Taux"
Range("U1").Select
ActiveCell.FormulaR1C1 = "Cours"
Range("X1").Select
ActiveCell.FormulaR1C1 = "Calcul"
Range("T1").Select
selection.Copy
Range("T1:X1").Select
selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Range("H3").Select
End If
End If
End Sub
Sub manque(feuilletravail2, feuilletravail, ref1)

Workbooks(feuilletravail).Activate
Sheets(1).Activate
Workbooks(feuilletravail2).Activate
lastlineP = lastline(strike)
For i = Deb To lastlineP
Workbooks(feuilletravail2).Activate
If Cells(i, Ref) <> "" Then
ref1 = Cells(i, Ref)
Call travail3(feuilletravail2, feuilletravail, ref1)
End If
Application.StatusBar = " Actuelle position des références non trouvées sur la feuille travail: " & i - Deb + 1 & "/" & lastlineP
Next i
End Sub

Sub travail3(feuilletravail2, feuilletravail, ref1)
Workbooks(feuilletravail).Activate
lastline6 = lastline("C")
Workbooks(feuillefact).Activate
Cells(Deb - 1, Ref).EntireRow.Select
selection.Copy
Workbooks(feuilletravail).Activate
Cells(lastline6 + 4, 1).Select
ActiveSheet.Paste
Workbooks(feuillefact).Activate
lastline7 = lastline("B")
For z = 2 To lastline7
Workbooks(feuillefact).Activate
If Cells(z, Ref) = ref1 Then
If Cells(z, Résult) = "" Then
Cells(z, Ref).EntireRow.Select
selection.Copy
Workbooks(feuilletravail).Activate
lastlineH = lastline(strike)
Cells(lastlineH + 1, 1).Select
ActiveSheet.Paste
Workbooks(feuillefact).Activate
End If
End If
Next z
Workbooks(feuilletravail).Activate
If Cells(lastline6 + 5, 2) = "" Then
Cells(lastline6 + 4, 1).EntireRow.Select
selection.Delete
Call MEF_cal
Call TCD2(feuilletravail2, feuilletravail, ref1)
End If
ActiveSheet.Next.Select
End Sub

Sub TCD2(feuilletravail2, feuilletravail, ref1)
lastlineM = lastline("C")
lieu = ("H" & lastlineM + 3)

If Range("A1") = "External trade number" Then
Call Listé(lieu, poulet)
End If

If Range("A1") Like "*External*" Then
Call Listé(lieu, poulet)
End If

End Sub

Sub OTC(lieu)
bobo = lastline("A")
dernièreColonne1 = selection.CurrentRegion.End(xlToRight).Column
lol = Range(Cells(1, "A"), Cells(bobo, dernièreColonne1))
compteur = compteur + 1
Nom = "TCD N°" & compteur

'TCD
ActiveSheet.PivotTableWizard _
SourceType:=xlDatabase, _
SourceData:=ActiveSheet.Range(Cells(1, "A"), Cells(bobo, dernièreColonne1)), _
TableDestination:=Range(lieu), _
TableName:=Nom

'Variable TCD
ActiveSheet.PivotTables(Nom).AddFields RowFields:= _
"Portfolio"
ActiveSheet.PivotTables(Nom).PivotFields("Brokerage"). _
Orientation = xlDataField
End Sub
Sub Strat(lieu)

bobo = lastline("A")
dernièreColonne1 = selection.CurrentRegion.End(xlToRight).Column
lol = Range(Cells(1, "A"), Cells(bobo, dernièreColonne1))
compteur = compteur + 1
Nom = "TCD N°" & compteur

'TCD
ActiveSheet.PivotTableWizard _
SourceType:=xlDatabase, _
SourceData:=ActiveSheet.Range(Cells(1, "A"), Cells(bobo, dernièreColonne1)), _
TableDestination:=Range(lieu), _
TableName:=Nom
'Variable TCD
ActiveSheet.PivotTables(Nom).AddFields RowFields:= _
"Book"
ActiveSheet.PivotTables(Nom).PivotFields("COURTAGE"). _
Orientation = xlDataField
End Sub
Sub Listé(lieu, poulet)

bobo = lastline("A")
dernièreColonne1 = selection.CurrentRegion.End(xlToRight).Column
poulet = Range(Cells(1, "A"), Cells(bobo, dernièreColonne1))
compteur8 = compteur8 + 1
Nom = "TCD N°" & compteur8

'TCD
ActiveSheet.PivotTableWizard _
SourceType:=xlDatabase, _
SourceData:=ActiveSheet.Range(Cells(1, "A"), Cells(bobo, dernièreColonne1)), _
TableDestination:=Range(lieu), _
TableName:=Nom
'Variable TCD
ActiveSheet.PivotTables(Nom).AddFields RowFields:= _
"""Party code"""
ActiveSheet.PivotTables(Nom).PivotFields("COURTAGE"). _
Orientation = xlDataField
End Sub

Private Sub Label16_Click()

End Sub

Private Sub MultiPage1_Change()

End Sub

 

[dnties]

Ik zie inderdaad dat ik ongelijk had: Ik was in de war met de Cell functie, terwijl hier de Cells functie wordt gebruikt.

Résult zou (gegeven de code erboven) een (Integer) kolomnummer van een cel moeten bevatten.
Ik vraag me af of de Left() functie daar 'lekker' mee omgaat, omdat die als eerste parameter een tekenreeks óf een volledige celverwijzing verwacht (zoals "A1") maar geen integer. Ik weet (ook) niet of het met de Variant declaratie van Résult wél is toegestaan.

Interessante vraag is of deze vba-code ooit gewerkt heeft of dat het blok code waar je nu het probleem mee hebt zojuist is toegevoegd/gewijzigd.

Tijs.

 

[BelgianEagle]

Ik zie inderdaad dat ik ongelijk had: Ik was in de war met de Cell functie, terwijl hier de Cells functie wordt gebruikt.

Résult zou (gegeven de code erboven) een (Integer) kolomnummer van een cel moeten bevatten.
Ik vraag me af of de Left() functie daar 'lekker' mee omgaat, omdat die als eerste parameter een tekenreeks óf een volledige celverwijzing verwacht (zoals "A1") maar geen integer. Ik weet (ook) niet of het met de Variant declaratie van Résult wél is toegestaan.

Interessante vraag is of deze vba-code ooit gewerkt heeft of dat het blok code waar je nu het probleem mee hebt zojuist is toegevoegd/gewijzigd.

Tijs.

Wat stel je dan voor?

Aangezien ik de userform niet kan uploaden, zal ik hem hier schetsen.

[Voorbeeld]

Price: H
Strike: N
Quanitité: K
Date: L
Commision fee: R
Zoeken in ander document: DOCUMENT.xls

Ik moet dus de kolom geven waar in ik de prijzen, strike, hoeveelheid en dergelijke kan terug vinden en deze laten vergelijken met een anders xls.

Je bent trouwens al enorm bedankt voor de tijd die je vrijmaakt!

 

[dnties]

Graag gedaan, maar ik moet nu toch gaan passen: VBA programmering is bij mij maar een beperkte vaardigheid, en ik vermoed dat anderen je vba-code beter kunnen interpreteren dan ik dat kan.

Je hebt nog 1 vraag niet beantwoord (zie vorige posting): Heeft de vba-code gewerkt zónder foutmeldingen en zo ja, wat is er veranderd dat je nu foutmeldingen krijgt?

Tijs.

 

[BelgianEagle]

Graag gedaan, maar ik moet nu toch gaan passen: VBA programmering is bij mij maar een beperkte vaardigheid, en ik vermoed dat anderen je vba-code beter kunnen interpreteren dan ik dat kan.

Je hebt nog 1 vraag niet beantwoord (zie vorige posting): Heeft de vba-code gewerkt zónder foutmeldingen en zo ja, wat is er veranderd dat je nu foutmeldingen krijgt?

Tijs.

Mijn chef heeft de userform al kunnen gebruiken, maar sinds kort doet ze moeilijk. Daarom heeft hij gevraagd of ik er eens naar kon kijken. Maar mijn vaardigheden qua VBA zijn nog veel kleinschaliger dan die van jou.

Kan het eraan liggen dat Engels en Frans een probleem is binnen een factuur met die code?

Kan je iemand aanraden hier op het forum die een echte expert is op dat gebied?

 

[dnties]

Die experts komen hoogstwaarschijnlijk vanzelf: Er is een uitgebreide reeks VB/VBA/Excel-cracks aanwezig. Bovendien is het niet gebruikelijk (en ook niet bedoeld) om leden individueel aan te schrijven via e-mail om aandacht te vragen voor een vraag die je hebt.

Misschien kun je je chef even 'ondervragen' of die een idee heeft wat er veranderd is sinds het moment dat het bruikbaar was tot het moment dat het niet meer bruikbaar was. Een forum is namelijk maar een beperkt hulpmiddel: We kunnen niet 'meekijken' noch bepalen wat iemand (ondertussen) op een computer gedaan/veranderd heeft.

Tijs.

 

[BelgianEagle]

Die experts komen hoogstwaarschijnlijk vanzelf: Er is een uitgebreide reeks VB/VBA/Excel-cracks aanwezig. Bovendien is het niet gebruikelijk (en ook niet bedoeld) om leden individueel aan te schrijven via e-mail om aandacht te vragen voor een vraag die je hebt.

Misschien kun je je chef even 'ondervragen' of die een idee heeft wat er veranderd is sinds het moment dat het bruikbaar was tot het moment dat het niet meer bruikbaar was. Een forum is namelijk maar een beperkt hulpmiddel: We kunnen niet 'meekijken' noch bepalen wat iemand (ondertussen) op een computer gedaan/veranderd heeft.

Tijs.

Dat begrijp ik wel en betreur ik ook dat ik hier geen screenshot van kan pakken. Maar inmiddels heb ik wel bijna de hele code gekopieerd op het forum, de bedoeling en de userform geschetst. Ik hoop dat rap iemand mijn noodkreet om hulp aanhoort, want we zitten hier anders maar wat vast op het werk.

 

[Warme bakkertje]

Open je VB-Editir eens en open het venster Lokale variabelen(Beeld >> lokale variabelen) Draai nu de code en als de foutmelding verschijnt ga je terug naar je VB-Editor en kijk je in dat deelvenster welke waarde Résult nu heeft.
M.i. moet dit een kolomletter zijn of een celverwijzing die is ingevuld in Textbox12. Met de functie Asc wordt dan het meest linkse teken (dat een letter zou moeten zijn) omgezet naar een getal dat dan gecontroleerd wordt op zijn grootte om vervolgens via een berekening een waarde toe te kennen aan RET