A voir également:
- VBA : sélection mutiple et suppression
- Excel compter cellule couleur sans vba - Guide
- Incompatibilité de type vba ✓ - Forum VB / VBA
- Erreur 13 incompatibilité de type VBA excel ✓ - Forum Excel
- Mkdir vba ✓ - Forum VB / VBA
- Vba range avec variable ✓ - Forum VB / VBA
7 réponses
Bonjour,
Pourquoi ne pas indiquer quelle colonnes sont concernées, d'où viennent les variables que tu utilises comme nptotal....
pas très encourageant pour essayer de t'aider
un code à adapter à ton appli
Pourquoi ne pas indiquer quelle colonnes sont concernées, d'où viennent les variables que tu utilises comme nptotal....
pas très encourageant pour essayer de t'aider
un code à adapter à ton appli
Option Explicit
Sub supprimer_1sur2()
Dim Derlig As Long
Dim T_tout(), T_demi
Dim cptr As Long, col As Byte
Dim start As Single
start = Timer
Application.ScreenUpdating = False
Derlig = Columns("A").Find("*", , , , , xlPrevious).Row
T_tout = Range("A2:E" & Derlig).Value
ReDim T_demi(Int(Derlig / 2), 4)
For cptr = 1 To UBound(T_tout) Step 2
For col = 0 To 4
T_demi(Int(cptr / 2), col) = T_tout(cptr, col + 1)
Next
Next
Range("A2:E" & Derlig).Clear
Range("A2").Resize(UBound(T_demi) + 1, 5) = T_demi
Application.ScreenUpdating = True
MsgBox "Durée: " & Timer - start & " sec."
End Sub
Merci.
J'ai bosser sur une macro tout le weekend et une grande partie de la nuit.
Je suis obligé de décrocher maintenant.
Je fournirai plus d'infos la prochaine fois.
Normalement je reprends ça la semaine prochaine.
Je testerai ta proposition et reviendrai sur le forum
Cordialement
J'ai bosser sur une macro tout le weekend et une grande partie de la nuit.
Je suis obligé de décrocher maintenant.
Je fournirai plus d'infos la prochaine fois.
Normalement je reprends ça la semaine prochaine.
Je testerai ta proposition et reviendrai sur le forum
Cordialement
Bonjour à tous,
Si c'est toute les lignee entières que tu supprimes tu peux le faire sans macro, ça prend 20s.
- insérer une colonne et y saisir en A1 =mod(ligne();2)
- recopier jusqu'en bas par un double-clic sur la poignée de recopie.
- copier-collage spécial valeur sur la colonne A
- trier sur A
- sélectionner les lignes avec 0 (ou 1) et supprimer
eric
Si c'est toute les lignee entières que tu supprimes tu peux le faire sans macro, ça prend 20s.
- insérer une colonne et y saisir en A1 =mod(ligne();2)
- recopier jusqu'en bas par un double-clic sur la poignée de recopie.
- copier-collage spécial valeur sur la colonne A
- trier sur A
- sélectionner les lignes avec 0 (ou 1) et supprimer
eric
L'objectif est d'automatiser le traitement d'un fichier. Cette opération n'est qu'une toute petite partie. J'ai trouver quelques solutions, je vous en ferez profiter dès que ce sera au point.
Cordialement
Cordialement
Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre question
On attend depuis 9 jours ta réaction....
ou peut-^tre tout simplement un "coucou, merci pur le temps passé"
L'esclave de service
ou peut-^tre tout simplement un "coucou, merci pur le temps passé"
L'esclave de service
Bonjour à tous
Projet non terminé, pas le temps de m'y mettre en ce moment.
Pas d'esclave... ni de coucou.... juste en situation de débordement.
Ci dessous partie de code commentée que j'ai adapté à partir de vos différentes aides. Y a sûrement moyen de faire mieux, mais pas le temps de creuser.
Sub ess5()
''avant ça, j'importe un fichier de données TXT qui comprend 18 lignes d'entête
''et un tableau de valeurs de 57600 lignes et 5 colonnes qui commence en cellule A19
''ce tableau doit être nettoyé d'une ligne sur deux
Application.ScreenUpdating = False
'récupération du nom de sauvegarde
NomDeSauvegarde = ActiveSheet.Name & ".xls"
nbligne = 57600 'nombre de ligne du tableau
nbcolonne = 5 'nombre de colonne du tableau
nbligne2 = nbligne / 2 'nombre de ligne après réduction des données
'début de chrono
temps = Timer
'suppression des lignes
'création des variables tableau
tablo1 = Range(Cells(19, 1), Cells(19 + nbligne, nbcolonne)).Value 'transfert du tableur dans tableau
ReDim tablo2(1 To nbligne2, 1 To nbcolonne) 'définition de la taille du tableau dynamique qui recevra les nouvelles données
'boucle de transfert des données d'un tableau à l'autre
For i = 1 To nbligne Step 2
x = x + 1
For j = 1 To nbcolonne Step 1
tablo2(x, j) = tablo1(i, j)
Next j
j = 0
Next i
'création de la feuille des données préparées
Sheets.Add
ActiveSheet.Name = "Données traitées"
Range("A1:e" & nbligne2).Value = tablo2 'transfert du tableau dans tableur
'mesure du temps d'éxécution et affichage
duree = Timer - temps
MsgBox "Temps d'éxécution = " & Format(duree, "0.00 \s") & Chr(13) & "Cliquer sur OK pour terminer"
End Sub
Projet non terminé, pas le temps de m'y mettre en ce moment.
Pas d'esclave... ni de coucou.... juste en situation de débordement.
Ci dessous partie de code commentée que j'ai adapté à partir de vos différentes aides. Y a sûrement moyen de faire mieux, mais pas le temps de creuser.
Sub ess5()
''avant ça, j'importe un fichier de données TXT qui comprend 18 lignes d'entête
''et un tableau de valeurs de 57600 lignes et 5 colonnes qui commence en cellule A19
''ce tableau doit être nettoyé d'une ligne sur deux
Application.ScreenUpdating = False
'récupération du nom de sauvegarde
NomDeSauvegarde = ActiveSheet.Name & ".xls"
nbligne = 57600 'nombre de ligne du tableau
nbcolonne = 5 'nombre de colonne du tableau
nbligne2 = nbligne / 2 'nombre de ligne après réduction des données
'début de chrono
temps = Timer
'suppression des lignes
'création des variables tableau
tablo1 = Range(Cells(19, 1), Cells(19 + nbligne, nbcolonne)).Value 'transfert du tableur dans tableau
ReDim tablo2(1 To nbligne2, 1 To nbcolonne) 'définition de la taille du tableau dynamique qui recevra les nouvelles données
'boucle de transfert des données d'un tableau à l'autre
For i = 1 To nbligne Step 2
x = x + 1
For j = 1 To nbcolonne Step 1
tablo2(x, j) = tablo1(i, j)
Next j
j = 0
Next i
'création de la feuille des données préparées
Sheets.Add
ActiveSheet.Name = "Données traitées"
Range("A1:e" & nbligne2).Value = tablo2 'transfert du tableau dans tableur
'mesure du temps d'éxécution et affichage
duree = Timer - temps
MsgBox "Temps d'éxécution = " & Format(duree, "0.00 \s") & Chr(13) & "Cliquer sur OK pour terminer"
End Sub
