A voir également:
- Vba comparaison ligne à ligne. optimiser
- Aller à la ligne excel - Guide
- Site de vente en ligne particulier - Guide
- Partager photos en ligne - Guide
- Apparaitre hors ligne instagram - Guide
- Optimiser son pc - Accueil - Utilitaires
2 réponses
alors j'ai testé avec 1941 lignes.
et je regarder le gestionnaire de tâches>performances et bien qu'excel ne réponde pas l'unité centrale est en pleine activité du coup pour une fois dans ma vie j'ai été patiente et en fait mon programme marche.
Là je le teste avec 5138 lignes et le suspens est insoutenables.
Quel magnifique monologue! :p
Merci quand meme à ceux qui ont réfléchis à mon problème :)
et je regarder le gestionnaire de tâches>performances et bien qu'excel ne réponde pas l'unité centrale est en pleine activité du coup pour une fois dans ma vie j'ai été patiente et en fait mon programme marche.
Là je le teste avec 5138 lignes et le suspens est insoutenables.
Quel magnifique monologue! :p
Merci quand meme à ceux qui ont réfléchis à mon problème :)
Alors le programme est un peu mieux mais plante à la ligne 824 help please :'(
Sub siorgane()
Dim dateech As Date
Dim aujourdhui As Date
Dim x As Integer
WaitX.Show vbModeless
WaitX.Caption = "Copie des données en cours"
WaitX.Label1.Caption = "Veuillez patienter..."
WaitX.Repaint
x = 0
aujourdhui = Date
c = 0
b = 0
While Not IsEmpty(Sheets("sauv").Cells(x + 6, 1))
c = x + 6
WaitX.Label1.Caption = "NB DE LIGNES A TRAITER : " & c & " / " & nbligne
WaitX.Repaint
b = i + 6
While Not IsEmpty(Sheets("CHARGE_EO").Cells(i + 6, 1))
b = i + 6
Set page_eo = ThisWorkbook.Worksheets("CHARGE_EO")
Set page_sauv = ThisWorkbook.Worksheets("sauv")
test = ThisWorkbook.Worksheets("CHARGE_EO").Cells(b, 1).Value = ThisWorkbook.Worksheets("sauv").Cells(c, 1).Value
For col = 2 To 18
test = test And page_eo.Cells(b, col) = page_sauv.Cells(c, col)
If Not (test) Then
Exit For
End If
Next col
If test Then
dateech = ThisWorkbook.Sheets("CHARGE_EO").Range("N" & b).Value
datederog = ThisWorkbook.Sheets("sauv").Range("V" & b).Value
reponse = ThisWorkbook.Sheets("sauv").Range("U" & b).Value
If Month(aujourdhui) = 12 And (Month(dateeech) = 1 Or Month(dateech) = 12) And Year(dateech) <= Year(aujourdhui) + 1 _
Or (Year(dateech) = Year(aujourdhui)) And (Month(dateech) <= Month(aujourdhui) + 1) Or dateech <= aujourdhui Then
copie_des_données_de_sauv_dans_charge_eo
End If
End If
i = i + 1
Wend
i = 0
'MsgBox b
x = x + 1
Wend
WaitX.Hide
End Sub
Sub siorgane()
Dim dateech As Date
Dim aujourdhui As Date
Dim x As Integer
WaitX.Show vbModeless
WaitX.Caption = "Copie des données en cours"
WaitX.Label1.Caption = "Veuillez patienter..."
WaitX.Repaint
x = 0
aujourdhui = Date
c = 0
b = 0
While Not IsEmpty(Sheets("sauv").Cells(x + 6, 1))
c = x + 6
WaitX.Label1.Caption = "NB DE LIGNES A TRAITER : " & c & " / " & nbligne
WaitX.Repaint
b = i + 6
While Not IsEmpty(Sheets("CHARGE_EO").Cells(i + 6, 1))
b = i + 6
Set page_eo = ThisWorkbook.Worksheets("CHARGE_EO")
Set page_sauv = ThisWorkbook.Worksheets("sauv")
test = ThisWorkbook.Worksheets("CHARGE_EO").Cells(b, 1).Value = ThisWorkbook.Worksheets("sauv").Cells(c, 1).Value
For col = 2 To 18
test = test And page_eo.Cells(b, col) = page_sauv.Cells(c, col)
If Not (test) Then
Exit For
End If
Next col
If test Then
dateech = ThisWorkbook.Sheets("CHARGE_EO").Range("N" & b).Value
datederog = ThisWorkbook.Sheets("sauv").Range("V" & b).Value
reponse = ThisWorkbook.Sheets("sauv").Range("U" & b).Value
If Month(aujourdhui) = 12 And (Month(dateeech) = 1 Or Month(dateech) = 12) And Year(dateech) <= Year(aujourdhui) + 1 _
Or (Year(dateech) = Year(aujourdhui)) And (Month(dateech) <= Month(aujourdhui) + 1) Or dateech <= aujourdhui Then
copie_des_données_de_sauv_dans_charge_eo
End If
End If
i = i + 1
Wend
i = 0
'MsgBox b
x = x + 1
Wend
WaitX.Hide
End Sub