code trop dur pour moi, m'aider à le comprendre SVP ?

marabane

XLDnaute Nouveau
Slt chers excelnautes !

J'ai reçu ce code hier de JP14 pour résoudre un pb. J'aimerai l'adapter à mon fichier normal mais je n'y arrive pas. Pourriez vous SVP m'aider à le comprendre en le commentant ?

Merci d'avance.

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(nomfeuille1).Range("a65536").End(xlUp).Row + 2

nomfeuille2 = "Feuil2" '"Feuil1"
col2 = "a"
lidep2 = 2
dl2 = Sheets(nomfeuille2).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(nomfeuille1)
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(nomfeuille1)

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

If ComboBox1.ListCount > 0 Then ComboBox1.Value = Sheets(nomfeuille1).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(nomfeuille1)
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 = "Feuil2"
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(£nomdest)

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

Staple1600

XLDnaute Barbatruc
Re : code trop dur pour moi, m'aider à le comprendre SVP ?

Bonsoir marabane, le fil, le forum


Peux-tu stp éditer ton message en utilisant les balises CODE

Dans ton premier message du cliques sur:
edit.gif

puis et tu sélectionnes le code VBA et tu cliques sur
code.gif


Merci.
 
Dernière édition:

jeanpierre

Nous a quitté
Repose en paix
Re : code trop dur pour moi, m'aider à le comprendre SVP ?

Bonsoir marabane,

Si tu étais resté sur le fil origine, celui-ci je pense : https://www.excel-downloads.com/threads/usf-qui-permet-recherche-selon-interval-date.107723/
ce serait sans doute plus simple pour suivre.

De plus ton présent titre n'est pas très top pour une recherche ultérieure.

Le principe est que l'on reste sur le même fil tant que la solution n'est pas complète.

A en tenir compte à l'avenir.

Bonne soirée.

Jean-Pierre
 

marabane

XLDnaute Nouveau
Re : code trop dur pour moi, m'aider à le comprendre SVP ?

Slt le forum,

Merci pour ta remarque jeanpierre. j'e tiendrais compte. je l'avais déjà fait et c resté lettre orte voilà pourquoi.

staple1600, j'ai fait l'opératon. j'espere que c plus lisible. merci pour votre aide.





Code:
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(nomfeuille1).Range("a65536").End(xlUp).Row + 2

nomfeuille2 = "Feuil2" '"Feuil1"
col2 = "a"
lidep2 = 2
dl2 = Sheets(nomfeuille2).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(nomfeuille1)
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(nomfeuille1)

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

If ComboBox1.ListCount > 0 Then ComboBox1.Value = Sheets(nomfeuille1).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(nomfeuille1)
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 = "Feuil2"
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(£nomdest)

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


 Règles de messages  
Vous pouvez créer de nouvelles discussions
Vous pouvez envoyer des réponses
Vous pouvez envoyer des pièces jointes
Vous pouvez modifier vos messages

--------------------------------------------------------------------------------

Les balises BB sont activées : oui
Les smileys sont activés : oui
La balise [IMG] est activée : oui
Le code HTML peut être employé : non
 

jeanpierre

Nous a quitté
Repose en paix
Re : code trop dur pour moi, m'aider à le comprendre SVP ?

Re marabane, JM,

Lettre morte ? hier à 20h43... ???

Il faut peut-être laisser aux gens d'ici le temps de souffler.... Ce ne sont que des bénévoles qui ont travail, famille et d'autres occupations.

Il faut être patient donc.

Ton code, en soit, peut être expliqué mais sorti du contexte de ta question initiale et du suivi ensuite, c'est autre chose.

Très difficile aussi de lire et d'étudier un long code à l'écran sans avoir le fichier.. Le fichier c'est le contexte, le code ce que l'on fait dans le fichier....

J'espère que tu comprends.

Bonne soirée.

Jean-Pierre
 

Statistiques des forums

Discussions
312 836
Messages
2 092 630
Membres
105 475
dernier inscrit
ramzi slama