transformer un tableau en un autre(vba)

Version imprimable

13/04/2008, 12h57
lesguignols

transformer un tableau en un autre(vba)

Bonjour,

J'ai un tableau que j'ai nommé à l'aide d'un petit programme vb; maintenant je souhaite transformer ce tableau et en créer un autre dans une nouvelle feuille en faisant les étapes suivantes :
- ajouter un jour à chaque date dans une une plage de B1 à H1
- supprimer les deux dérnières colonnes du tableau
- virer toutes les lignes qui contiennent plus d'une case vide sauf les ligne qui ont des A2, A3... vérifiant une certainte condition (ont des valeurs par exemple comprises entre 39 et 41 et ensuite entre 79 et 81...)
- prendre la cellule B8 et lui affecter une règle

Pouvez vous me donner des point de départ SVP ?

Merci d'avance

Pour supprimer les lignes vides... ou presque :
Code:

1 2 3 4 5 6 7 Sub Test() For NoLig = 1 To Cells.SpecialCells(xlCellTypeLastCell).Row If Application.WorksheetFunction.CountA(Range(Cells(NoLig, 1), Cells(NoLig, 255))) < 2 Then 'effaces les lignes contenant plus d'une cellule renseignée Rows(NoLig).EntireRow.Delete End If Next End Sub
Tu peux naturellement ajouter des conditions dans le if ... then (entre Then et ... .delete) pour ignorer les cellules contenant ce quelles doivent contenir ;)

13/04/2008, 16h53
patbou

bonjour

Citation:

ajouter un jour à chaque date dans une une plage de B1 à H1

tu peux utiliser la fonction dateadd pour cela
13/04/2008, 17h05
Gorfael
Salut lesguignols et le forum

Citation:

- ajouter un jour à chaque date dans une une plage de B1 à H1
Code:

1 2 3 4 5 Dim Cel As Range .................... For Each Cel In Range("B1:H1") If IsDate(Cel) Then Cel = Cel + 1 Next Cel
Citation:

- supprimer les deux dérnières colonnes du tableau

lesquelles sont tes dernières colonnes ? (Désolé, ma boule de cristal est en panne)

Citation:

- virer toutes les lignes qui contiennent plus d'une case vide sauf les ligne qui ont des A2, A3... vérifiant une certainte condition (ont des valeurs par exemple comprises entre 39 et 41 et ensuite entre 79 et 81...)

J'ai beau tirer les cartes, elles ne veulent pas révéler les règles exactes. Il faut dire que je ne suis pas bon en cartomancie

Citation:

.- prendre la cellule B8 et lui affecter une règle

un double-décimètres suffira, ou il faut plus grand ?

A+
13/04/2008, 18h05
lesguignols

pas mal si les réponses sont toutes comme ça. ça me fait avancer incroyablement :) si non ouskel'n'or pourquoi t'as mis (Nolig,255) pourquoi 255? et pourquoi dans le "if" t'as mis la condition < 2 ? il faudrait > 2 je pense non ?
13/04/2008, 19h43
Gorfael

Salut lesguignols

Citation:

pas mal si les réponses sont toutes comme ça. ça me fait avancer incroyablement :)

Et si les questions sont aussi vagues, on va plus avancer !
Remarque, tu as raison. Je ferais mieux de ne pas répondre
A+
13/04/2008, 19h57
ouskel'n'or

Citation:

Envoyé par lesguignols

pas mal si les réponses sont toutes comme ça. ça me fait avancer incroyablement :) si non ouskel'n'or pourquoi t'as mis (Nolig,255) pourquoi 255? et pourquoi dans le "if" t'as mis la condition < 2 ? il faudrait > 2 je pense non ?

Parce que dans Excel 2003 (ma version) il y a 256 colonnes.
Pour la condition : La fonction utilisée (counta) compte les cellules renseignées. Si tu mets > 1 tu effaces toutes tes lignes qui ont plus d'une cellule renseignée. :mouarf:
Regarde dans l'aide Excel, c'est l'équivalent de la fonction NBVAL.
13/04/2008, 20h41
lesguignols

Citation:

Et si les questions sont aussi vagues, on va plus avancer !
Remarque, tu as raison. Je ferais mieux de ne pas répondre

je ne voulais pas rejeter tes réponses Gorfael; il faut pas le prendre comme ça; mais je n'ai pas détailler mes questions pour ne pas géner les gens et qu'ils trouvent mon problème compliqué. j'ai essayé de simplifier le maximum c'est tout. mais au cas où quelqu'un porrait m'essayer c'est avec plaisir car je bloque toujours sur quelques points.

Citation:

La fonction utilisée (counta) compte les cellules renseignées. Si tu mets > 1 tu effaces toutes tes lignes qui ont plus d'une cellule renseignée.

.
en fait ouskel'n'or, je voudrais supprimer les lignes de mon tableau qui contiennent au moins une cellule vide et dont la première cellule ne cotient pas un chiffre entre 39 et 41. quelle fonction peut remplacer counta et qui pourrait m'aider à faire ça.

merci bien

Bonjour tlm,

Je vous propose mes solutions,

Pour :

Citation:

ajouter un jour à chaque date dans une une plage de B1 à H1

Pas mieux que Gorfael

Pour :

Citation:

supprimer les deux dérnières colonnes du tableau
Code:

1 2 3 4 5 6 Sub test1() Dim DerCol As Byte DerCol = Cells(1, Columns.Count).End(xlToLeft).Column Range(Cells(1, DerCol - 1), Cells(1, DerCol)).EntireColumn.Delete End Sub
Pour :

Citation:

je voudrais supprimer les lignes de mon tableau qui contiennent au moins une cellule vide et dont la première cellule ne cotient pas un chiffre entre 39 et 41
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 Sub test2() Dim i As Integer, j As Integer, DerCol As Byte DerCol = Cells(1, Columns.Count).End(xlToLeft).Column For i = Cells(Rows.Count, 1).End(xlUp).Row To 1 Step -1 If Cells(i, 1) <> 39 And Cells(i, 1) <> 40 And Cells(i, 1) <> 41 Then For j = 1 To DerCol If Cells(i, j) = "" Then Rows(i).Delete Exit For End If Next End If Next End Sub

13/04/2008, 22h41
lesguignols

Merci bien pour ton aide fring; deux autres questions SVP:
1)Comment je peux pointer tout mon travail sur le tableau en question qui se trouve dans Feuil1 et en créer le nouveau qui se mettra par exemple en Feuil2
2)est ce que toutes ces étapes je peux les mettre chacune sous une "sub" ou je dois mettre ça dans un module ? je voudrais tout faire dans une seule procédure juste pour éviter que la macro me demande à chaque fois de lancer chaque procédure.

Merci
13/04/2008, 22h52
fring

Pour le point 1, je ne comprend pas bien la question, tu veux d'abord copier le tableau en feuille 2 et ensuite lancer la procèdure sur le tableau en feuille 2 ?

Pour le point 2, oui bien sur que l'on peut tout rassembler dans une seule procédure, je te donnerai une solution lorsque j'aurai la réponse au point 1
13/04/2008, 23h10
lesguignols

Citation:

Pour le point 1, je ne comprend pas bien la question, tu veux d'abord copier le tableau en feuille 2 et ensuite lancer la procèdure sur le tableau en feuille 2 ?

En fait je veux savoir si j'ai besoin de pointer tout le travail que je fais sur ce tableau (ajouter un jour aux dates, supprimer les deux dérnières colonnes...) ou bine ça va suffir de se mettre sur la feuille ou le tableau se trouve et lancer la macro. Ensuite je voudrais carrément créer une autre feuille dans laquelle j'ai mon nouveau tableau obtenu à partir de l'ancien et ayant un nom différent.
ou bien serait il possible que la macro ne fasse pas les modif sur le tableau d'origine et qu'elle crée une autre feuille dans laquelle elle mettra le nouveau tableau obtenu.

Merci fring

La solution que je te propose est la suivante :

En supposant que ton tableau se trouve en feuille 1, on copie l'entièreté de la feuille après celle-ci et ensuite on exécute la macro sur cette nouvelle feuille (feuille 2)

De cette manière ton tableau original ne bouge pas

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
Sub Copie_Tableau()
Dim Cel As Range, DerCol As Byte, i As Integer, j As Integer
 
'copie de la feuille 1 après celle-ci
Sheets(1).Copy after:=Sheets(1)
 
 
With Sheets(2)
    'nom de la nouvelle feuille
    .Name = "nom de la nouvelle feuille"
 
    'suppression des deux dernières colonnes
    DerCol = .Cells(1, Columns.Count).End(xlToLeft).Column
    .Range(.Cells(1, DerCol - 1), .Cells(1, DerCol)).EntireColumn.Delete
 
    'ajout d'un jour pour chaque date de B1 à H1
    For Each Cel In .Range("B1:H1")
        If IsDate(Cel) Then Cel = Cel + 1
    Next Cel
 
    'suppression des lignes vides
    For i = .Cells(Rows.Count, 1).End(xlUp).Row To 1 Step -1
        If .Cells(i, 1) <> 39 And .Cells(i, 1) <> 40 And .Cells(i, 1) <> 41 Then
            For j = 1 To DerCol - 2
                If .Cells(i, j) = "" Then
                .Rows(i).Delete
                Exit For
                End If
            Next
        End If
    Next
End With
 
End Sub

14/04/2008, 00h04
lesguignols

Juste un truc, quand je remplace la condition

Code:

.Cells(i, 1) <> 39 And .Cells(i, 1) <> 40 And .Cells(i, 1) <> 41

par :

Code:

Cells(i, 1) <= 49 And 60<=Cells(i, 1) <= 70 And 80 <= Cells(i, 1) <= 90

ça ne supprime aucune ligne, ça ne fait RIEN. je sais pas s'il faut spécifier une conditio parce qu'en fait, les chiffre contenus dans les cellules sont des réels.
Une autre remarque : les .cells que t'as rajouté à chaque fois les détecte comme erreurs, je sais pas pourquoi

Citation:

Envoyé par lesguignols

Une autre remarque : les .cells que t'as rajouté à chaque fois les détecte comme erreurs, je sais pas pourquoi

C'est que tu as du modifier quelque chose qu'il ne fallait pas, avant de te proposer le code je l'ai testé et il fonctionne.

Concernant les différentes conditions, il me semblait que...

Citation:

je voudrais supprimer les lignes de mon tableau qui contiennent au moins une cellule vide et dont la première cellule ne cotient pas un chiffre entre 39 et 41

8O pourquoi ne pas avoir directement donné les bonnes conditions ????

Teste ceci :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
Sub Copie_Tableau()
Dim Cel As Range, DerCol As Byte, i As Integer, j As Integer
 
'copie de la feuille 1 après celle-ci
Sheets(1).Copy after:=Sheets(1)
 
 
With Sheets(2)
    'nom de la nouvelle feuille
    .Name = "nom de la nouvelle feuille"
 
    'suppression des deux dernières colonnes
    DerCol = .Cells(1, Columns.Count).End(xlToLeft).Column
    .Range(.Cells(1, DerCol - 1), .Cells(1, DerCol)).EntireColumn.Delete
 
    'ajout d'un jour pour chaque date de B1 à H1
    For Each Cel In .Range("B1:H1")
        If IsDate(Cel) Then Cel = Cel + 1
    Next Cel
 
    'suppression des lignes vides
    For i = .Cells(Rows.Count, 1).End(xlUp).Row To 1 Step -1
        Select Case .Cells(i, 1)
        Case Is <= 49, 60 To 70, 80 To 90
            For j = 1 To DerCol - 2
                If .Cells(i, j) = "" Then
                .Rows(i).Delete
                Exit For
                End If
            Next
        End Select
    Next
End With
 
End Sub

Va pour "entre 39 et 41 et ensuite entre 79 et 81..."

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Sub Test()
Dim ok As Boolean
    'Si ok on doit supprimer les lignes
    For NoLig = Cells.SpecialCells(xlCellTypeLastCell).Row To 1 Step -1
        Cells(NoLig, 1).Select
        'ok si une seul cellule renseignée
        ok = Application.WorksheetFunction.CountA(Range(Cells(NoLig, 1), Cells(NoLig, 255))) < 2
        'sauf si la cellule contient une valeur entre 39 et 41 -> ( > 38 et < 42 )
        ok = ok And (Not (Cells(NoLig, 1) > 38 And Cells(NoLig, 1) < 42)) And _
        (Not (Cells(NoLig, 1) > 78 And Cells(NoLig, 1) < 82))
        'et sauf si la cellule contient une valeur entre 79 et 82 -> ( > 78 et < 82 )
        'et si tu as des conditions à ajouter, tu les ajoutes
        '...
        'effaces les lignes contenant plus d'une cellule renseignée et qui réunit
        'les conditions ci-dessus
         If ok Then Rows(NoLig).EntireRow.Delete
    Next
End Sub

Bonne nuit

14/04/2008, 09h20
lesguignols

Je n'ai pas donné les bonnes conditions car les miennes sont un peu longues et j'ai donné juste un exemple parce que je croyais que le principe reste le même mais apparament ça n'a pas marché, je vais essayer vos propositions
Merci
14/04/2008, 10h12
ouskel'n'or

Citation:

Envoyé par lesguignols

Je n'ai pas donné les bonnes conditions

C'est malin ! :mouarf:

Citation:

Case Is <= 49, 60 To 70, 80 To 90

en fait, avec cette condition ça ne marche pas chez moi, il efface pas toutes les lignes.
Pour être plus clair; je voudrais garder les lignes qui ont la première colonne contenant des chiffres entre 79 et 82, entre 98 et 102 , entre 118 et 122; et effacer toutes les autres lignes qui contiennent au mois une une case vide, j'ai donc écris le code suivant :
Code:

1 2 3 4 5 6 For i = .Cells(Rows.Count, 1).End(xlUp).Row To 1 Step -1 Select Case .Cells(i, 1) Case 30 to 79, 83 To 98, 103 To 117, 123 to 190 For j = 1 To DerCol - 2 If .Cells(i, j) = "" Then .Rows(i).Delete
c'est bizarre parce que ça marche que pour quelques lignes mais pas pour les dérnières lignes !! avez vous des rectifications !

14/04/2008, 23h59
ouskel'n'or

Citation:

Envoyé par lesguignols Hier, 12h57

je souhaite transformer ce tableau et en créer un autre dans une nouvelle feuille en faisant les étapes suivantes :
- ...
- ...
- virer toutes les lignes qui contiennent plus d'une case vide

Citation:

Envoyé par lesguignols Aujourd'hui 21h41

Pour être plus clair; je voudrais garder les lignes gna gna gna et effacer toutes les autres lignes qui contiennent au moins une case vide,

Citation:

Envoyé par lesguignols Hier, 12h57

- virer toutes les lignes gnagna... sauf les ligne gnagnagna... condition (ont des valeurs par exemple comprises entre 39 et 41 et ensuite entre 79 et 81...)

Citation:

Envoyé par lesguignols Aujourd'hui 21h41

Pour être plus clair; je voudrais garder les lignes qui ont la première colonne contenant des chiffres entre 79 et 82, entre 98 et 102 , entre 118 et 122

Décide-toi !
Tu nous prends vraiment pour des guignols ? (excuse, je n'ai pas pu m'en empêcher :mouarf: )
Quand tu seras claire avec toi-même, reviens-nous ;)
15/04/2008, 00h10
ouskel'n'or

Edit
J'avais oublié

Citation:

Envoyé par lesguignols Hier, 12h57

sauf les ligne qui ont des A2, A3

La traduction siouplé !
15/04/2008, 01h06
fring

Dans la série "je me fous de la g... du monde" tu as oublié un épisode Ousk... ;)

Citation:

Envoyé par lesguignols

Code:

Cells(i, 1) <= 49 And 60<=Cells(i, 1) <= 70 And 80 <= Cells(i, 1) <= 90

Moi je laisse la main, notre ami à je pense toutes les cartes en mains pour pouvoir adapter les codes au prochain tirage du loto.

Bonne nuit