Pb de compréhension d'un code

Le 24/11/2008 à 17:47

Bonjour,

J'ai reçu un code pour solutionner un problème. Je n'arrive pas à l'adapter car ne le comrenant pas bien.

Le code VBA me permet de faire des recherches selon des dates (échéance 1 ou échéance 2) et copie le résultat dans feuil2. il est lancé par le bouton dans feuil1.

Je vous joint le fichier. Si quelqu'un pouvait m'aider en le commentant, cela me dépannerai beaucoup. je suis dessus depuis un bon moment et je n'avance pas. Ou à défaut si quelqu'un connait une autre méthode pour faire la meme chose je suis preneur.

Merci pour votre coup de main.

Cordialement.

https://www.excel-pratique.com/~files/doc/recherche.zip

Le 24/11/2008 à 18:15

hello

suggestion : copier les données dans une feuille 2 et faire un filtre auto, et utiliser (personnalisé...)

l'enregistreur de macros peut sans doute t'aider à automatiser tout ça.

Le 24/11/2008 à 18:18

Bonjour,

Il y a pas mal de travail là pour te commenter tout le code.

Pourquoi ne demandes-tu pas à l'auteur de ce fichier ?

A te relire

Dan

Le 24/11/2008 à 18:25

Je l'ai fait Dan. C'est resté lettre morte malgré mes relances et je me suis fait engueulé.

Alors j'ai voulu voir ailleurs si on pouvait m'aider. A défaut me mettre sur une autre piste. Mais si c impossible, c'est pas grave. Merci quand même

Le 24/11/2008 à 18:28

Re,

Ce n'est pas impossible mais il y a du travail. On peut faire cela pas à pas si tu le souhaites.

Le mieux est que tu me dises déjà quels sont les parties de code qui te posent un pb

Amicalement

Dan

Edit : Dommage que tu aies changé de pseudo.

Le 24/11/2008 à 18:34

Merci Dan.

Je me suis dis que c'est surement le pseudo qui me portait la poisse... 8) .

Je viens de poster une nouvelle demande làbas.

voilà comment je l'ai réadapté, mais la derniere partie me pose pb:

Option Explicit
'
Dim nomfeuille1 As String
Dim col1 As String
Dim lidep1 As Long

Dim lidep2 As Long
Dim nomfeuille2 As String
Dim col2 As String

Dim data1 As String

Dim chemin As String
Dim classeur1 As String

Dim date1 As Date
Dim date2 As Date

Dim nb As Integer
Dim trouve As Boolean
Dim sh As Worksheet
Dim j As Long

Private Sub CommandButton1_Click()
Unload Me
End Sub

'-------------------------------------------------------------------------------------
' Module    : UserForm1/CommandButton2_Click
' DateTime  : 20/11/2008 / 19:29
' Auteur    : JP14
' Bouton          :valider
'-------------------------------------------------------------------------------------
Private Sub CommandButton2_Click()
Dim i As Long
Dim j As Long
Dim dl1 As Long
Dim dl2 As Long

Dim cellule As Range
Dim plage As Range

Dim lidep2 As Long
Dim nomfeuille2 As String
Dim col2 As String

Dim date1 As Date
Dim date2 As Date

'**********************************
dl1 = Sheets("Données").Range("a65536").End(xlUp).Row + 2

nomfeuille2 = "resultat" '"Données"
col2 = "a"
lidep2 = 2
dl2 = Sheets("resultat").Range("a65536").End(xlUp).Row + 1
'************************************
If IsDate(ComboBox1.Value) Then
    date1 = ComboBox1.Value
Else
    Call MsgBox("Date de début non conforme" _
                & vbCrLf & "" _
                , vbCritical, Application.Name)
    Exit Sub
End If
If IsDate(ComboBox2.Value) Then
    date2 = ComboBox2.Value
Else
    Call MsgBox("Date de fin non conforme" _
                & vbCrLf & "" _
                , vbCritical, Application.Name)
    Exit Sub
End If

With Sheets("Données")
Set plage = .Range(col1 & lidep1 & ":" & col1 & .Range(col1 & "65536").End(xlUp).Row)
For Each cellule In plage
     If IsDate(cellule.Value) Then
        If date1 <= cellule.Value And cellule.Value <= date2 Then
        ' dans la plage on copie
        Call ajoutlig(nomfeuille2, "a", nomfeuille1, cellule.Row)
        End If
     End If
Next cellule

End With

End Sub

Private Sub OptionButton1_Click()
If OptionButton1.Value = True Then
ComboBox1.Clear
ComboBox2.Clear
ComboBox1.Style = fmStyleDropDownCombo
ComboBox2.Style = fmStyleDropDownCombo
    'Récupère les données de la colonne g...
With Sheets("Données")

    For j = lidep1 To .Range("AB65536").End(xlUp).Row

        If ComboBox1.ListCount > 0 Then ComboBox1.Value = Sheets("Données").Range("AB" & j)

        '...et filtre les doublons
        If ComboBox1.ListIndex = -1 Then
            ComboBox1.AddItem .Range("AB" & j)
            ComboBox2.AddItem .Range("AB" & j)
        End If
    Next j

End With
End If
ComboBox1.Value = ""
ComboBox1.Style = fmStyleDropDownList
ComboBox2.Style = fmStyleDropDownList
col1 = "AB"
End Sub

Private Sub OptionButton2_Click()
If OptionButton2.Value = True Then
ComboBox1.Style = fmStyleDropDownCombo
ComboBox2.Style = fmStyleDropDownCombo
    'Récupère les données de la colonne g...
With Sheets("données")
ComboBox1.Clear
ComboBox2.Clear
    For j = lidep1 To Range("Ad65536").End(xlUp).Row
        If ComboBox1.ListCount > 0 Then ComboBox1.Value = .Range("AB" & j)
        'ComboBox1.Value = .Range("Ad" & j)
        '...et filtre les doublons
        If ComboBox1.ListIndex = -1 Then
        ComboBox1.AddItem .Range("Ad" & j)
        ComboBox2.AddItem .Range("Ad" & j)
        End If
    Next j

End With
End If
col1 = "AD"
ComboBox1.Value = ""
ComboBox1.Style = fmStyleDropDownList
ComboBox2.Style = fmStyleDropDownList
End Sub

Private Sub UserForm_Initialize()
nomfeuille1 = "Feuil1"
lidep1 = 2

End Sub
Private Sub ajoutlig(£nomdest As String, £col As String, £nomorigine As String, £ligacop As Long)
 Call ajoutlig
 '("feuille destination", "colonne pour trouver la dernière ligne", "feuille origine", "ligne à copier")
With Sheets("resultat")

  '************la partie qui me pose pb car j'ai un message d'incompatibilité***********

    Sheets(£nomorigine).Rows(£ligacop).Copy _
     Destination:=.Rows(.Range(£col & "65536").End(xlUp).Row + 1)
 End With
End Sub
Le 24/11/2008 à 18:39

Peut-on faire la meme chose sans VBA ?

Le 24/11/2008 à 18:44

Re,

Quelle est la partie qui te pose soucis dans ce code ?

Sans VBA, tu peux faire ce que Jmd te dit, filtre les données en mettant le filtre automatique puis copier les données dans l'autre feuille.

Si oui, il faut repenser le code bien entendu mais il sera plus simple.

A te relire

Dan

Le 24/11/2008 à 18:55

Merci de me repondre,

aprés modification, c'est cette partie qui ne mrche pas:

Private Sub ajoutlig(£nomdest As String, £col As String, £nomorigine As String, £ligacop As Long) 
 Call ajoutlig 
 '("feuille destination", "colonne pour trouver la dernière ligne", "feuille origine", "ligne à copier") 
With Sheets("resultat") 

  '************la partie qui me pose pb car j'ai un message d'incompatibilité*********** 

    Sheets(£nomorigine).Rows(£ligacop).Copy _ 
     Destination:=.Rows(.Range(£col & "65536").End(xlUp).Row + 1) 
 End With 
End Sub

je sais qu'il ya un passage de paramettre mais je sais pas comment l'adapter. à ce que je veux.

Le 24/11/2008 à 19:08

Tu ne croiras jamais Dan !!!

j'ai retrouvé mon erreur !!!!!!!!!!!!!!!!!!

Merci de m'avoir écouté. Je reviendrais dés que j'ai un autre pepin.

Merci pour tout

4planning-2015.xlsx (152.00 Ko)
Le 24/11/2008 à 19:15

Re,

Le Call ajoutlig est amibigu là. Tu appelles une procédure ajoutlig dans la procédure Private ajoutlig.

Vérifie d'abord là

Dan

Le 24/11/2008 à 19:34

Bonsoir,

comme tu avais aussi demandé une autre méthode, regarde celle-ci (dans le fichier joint)

le code :

Option Explicit
Dim LesDates As Object
Dim Cel As Range
Dim DerLig As Long
Private Sub CommandButton1_Click()
Unload Me
End Sub
Private Sub CommandButton2_Click()
If Not (Me.OptionButton1) And Not (Me.OptionButton2) Then
    MsgBox "Sélectionnez une échance"
    Exit Sub
End If
If Me.ComboBox1 = "" Or Me.ComboBox2 = "" Then
    MsgBox "Veuillez entrer les deux dates de critères"
    Exit Sub
End If
With Sheets("Feuil2")
   .[AK2].FormulaR1C1 = _
        "=AND(Feuil1!RC[-9]>=DateValue(""" & Me.ComboBox1 & """),Feuil1!RC[-9]<=DateValue(""" & Me.ComboBox2 & """))"
    Range("base").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=.Range( _
        "AK1:AK2"), CopyToRange:=.Range("A1:AI1"), Unique:=False
    .[AK2].ClearContents
End With
Unload Me
End Sub

Private Sub OptionButton1_Click()
Me.ComboBox1.Clear: Me.ComboBox2.Clear
On Error Resume Next
LesDates.RemoveAll
On Error GoTo 0
For Each Cel In Range("AB2:AB" & DerLig)
    If Not LesDates.Exists(Cel.Value) Then LesDates.Add Cel.Value, Cel.Value
Next Cel
Me.ComboBox1.List = Application.Transpose(LesDates.items)
Me.ComboBox2.List = Application.Transpose(LesDates.items)
End Sub

Private Sub OptionButton2_Click()
Me.ComboBox1.Clear: Me.ComboBox2.Clear
On Error Resume Next
LesDates.RemoveAll
On Error GoTo 0
For Each Cel In Range("AD2:AD" & DerLig)
    If Not LesDates.Exists(Cel.Value) Then LesDates.Add Cel.Value, Cel.Value
Next Cel
Me.ComboBox1.List = Application.Transpose(LesDates.items)
Me.ComboBox2.List = Application.Transpose(LesDates.items)
End Sub

Private Sub UserForm_Initialize()
Set LesDates = CreateObject("Scripting.Dictionary")
With Sheets("Feuil1")
    DerLig = .[A65000].End(xlUp).Row
    .Range("A1:AI1").Copy Sheets("Feuil2").Range("A1")
    .Range("A1:AI" & DerLig).Name = "base"
End With
End Sub

le fichier :

https://www.excel-pratique.com/~files/doc/recherche_v2.xls

Le 24/11/2008 à 20:32

Re,

Autre méthode dans le fichier ci-joint et ce, sans USF :

  • Dans la feuille 1, utilise les filtres automatique en ligne 1 pour faire ton choix
  • Clique sur le bouton pour transférer en feuille 2 les données filtrées

FICHIER

Amicalement

Dan

Le 27/11/2008 à 22:31

Slt Dan,

Mille excuse pour le retard dans ma reponse. Je suis tombé malade. là ça va mieux.

Woua ! j'ai principalement adoré la solution du fichier recherche_dan. C plus sympa et juste. Je l'ai adopté et adapté san pb particulier.

Merci pour tout Dan.

@ bientot.

Rechercher des sujets similaires à "comprehension code"