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

M

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
 
Trier par date Trier par votes
Staple1600

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:
Vote positif 0 Vote négatif
jeanpierre

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
 
Vote positif 0 Vote négatif
M

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
 
Vote positif 0 Vote négatif
jeanpierre

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
 
Vote positif 0 Vote négatif

Discussions similaires

Regueiro
  • Question
Microsoft 365 VBA Transpose
Réponses
11
Affichages
393
sylvanu
sylvanu
D
  • Question
XL 2021 Filtre Multi Critères Listview VBA
2
Réponses
21
Affichages
596
Dranreb
Dranreb
M
  • Question
XL 2010 Calcul possible dans la zone de liste pour le débit et le crédit lors d'une recherche basée sur la zone de texte
Réponses
0
Affichages
471
Mody200
M
P
  • Question
Microsoft 365 VBA insert photos
Réponses
12
Affichages
542
PHV62
P
A
  • Résolu(e)
Microsoft 365 Correction du code vba
Réponses
5
Affichages
269
AD95
A
E
  • Question
XL 2013 vba excel
Réponses
6
Affichages
325
sylvanu
sylvanu
A
  • Question
Microsoft 365 Code VBA Envoi contenu tableau Excel par Email
Réponses
1
Affichages
180
Phil69970
Phil69970
G
  • Question
Microsoft 365 Saut de ligne dans une cellule
Réponses
3
Affichages
231
GClaire
G
F
  • Question
XL 2019 erreur 1004
Réponses
8
Affichages
302
florian50470
F
S
  • Résolu(e)
Microsoft 365 Récupérer la date dans un calendrier
Réponses
2
Affichages
190
sebastien176
S

Membres actuellement en ligne

9 membres et 83 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 836
Messages
2 092 649
Membres
105 478
dernier inscrit
tim51