IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)
Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

Macros et VBA Excel Discussion :

Delete de row entre deux row renommées [XL-2007]


Sujet :

Macros et VBA Excel

Vue hybride

Message précédent Message précédent   Message suivant Message suivant
  1. #1
    Membre averti
    Inscrit en
    Juillet 2011
    Messages
    32
    Détails du profil
    Informations forums :
    Inscription : Juillet 2011
    Messages : 32
    Par défaut Delete de row entre deux row renommées
    Bonjour à toutes et à tous,

    Je rencontre un problème pour effacer les lignes que je génère avec le code ci-dessous.
    Une ligne est créée en fonction de la ldatewish1value(bsum).
    Mon problème est qu’une fois ces lignes créées je souhaiterais faire un delete sur les lignes qui ont été ajoutées.
    J’ai voulu essayer de nommer les lignes pour faire un delete entre deux lignes mais il se trouve que ma ligne se décale et perd le nom que je lui ai passé.
    Pouvez-vous m’aider ou m’indiquer si une solution plus simple existe ?
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    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
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
     
    On Error GoTo passealasuite
    nbre_mois = ((Year(Date) - Year(ldatewish1value(bsum))) * 12) + Month(Date) - Month(ldatewish1value(bsum))
    nbre_mois = nbre_mois
    On Error GoTo passealasuite
     
        If lsummary1value(bsum) = Empty Or lsummary1value(bsum) = "" Then lsummary1value(bsum) = " -- "
        If lTeam1value(bsum) = Empty Or lTeam1value(bsum) = "" Then lTeam1value(bsum) = " -- "
        If lresponsible1value(bsum) = Empty Or lresponsible1value(bsum) = " " Then lresponsible1value(bsum) = " -- "
        If ldatewish1value(bsum) = Empty Or ldatewish1value(bsum) = "" Then ldatewish1value(bsum) = " -- "
        If lstatus1value(bsum) = Empty Or lstatus1value(bsum) = "" Then lstatus1value(bsum) = " -- "
     
        If ldatewish1value(bsum) = " -- " Then GoTo dt 'pas de date wish goto <1 mois
     
        If nbre_mois < 1 Then
    dt:
            Application.ScreenUpdating = False
            Sheet9.Activate
            Sheet9.range("Actionplan1").Offset(1, 0).Select
            Selection.Insert
            Sheet9.range("Actionplan1").Select
            Selection.Copy
            Sheet9.range("Actionplan1").Offset(1, 0).Select
            ActiveSheet.Paste
     
                   Sheet9.range("shorttermactions1").Offset(1) = lsummary1value(bsum)
                   Sheet9.range("shorttermteam1").Offset(1) = lTeam1value(bsum)
                   Sheet9.range("shorttermresponsible1").Offset(1) = lresponsible1value(bsum)
                   Sheet9.range("shorttermduedate1").Offset(1) = ldatewish1value(bsum)
                   Sheet9.range("shorttermstatus1").Offset(1) = lstatus1value(bsum)
     
                 Application.ScreenUpdating = False
                GoTo passealasuite
     
         ElseIf nbre_mois >= 1 And nbre_mois < 3 Then
     
            Application.ScreenUpdating = False
            Sheet9.Activate
            Sheet9.range("Actionplan2").Offset(1, 0).Select
            Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
            Sheet9.range("Actionplan2").Select
            Selection.Copy
            Sheet9.range("Actionplan2").Offset(1, 0).Select
            ActiveSheet.Paste
     
                   Sheet9.range("mediumtermactions1").Offset(1) = lsummary1value(bsum)
                   Sheet9.range("mediumtermteam1").Offset(1) = lTeam1value(bsum)
                   Sheet9.range("mediumtermresponsible1").Offset(1) = lresponsible1value(bsum)
                   Sheet9.range("mediumtermduedate1").Offset(1) = ldatewish1value(bsum)
                   Sheet9.range("mediumtermstatus1").Offset(1) = lstatus1value(bsum)
     
                 Application.ScreenUpdating = False
                GoTo passealasuite
     
        ElseIf nbre_mois >= 3 Then
     
            Application.ScreenUpdating = False
            Sheet9.Activate
            Sheet9.range("Actionplan3").Offset(1, 0).Select
            Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
            Sheet9.range("Actionplan3").Select
            Selection.Copy
            Sheet9.range("Actionplan3").Offset(1, 0).Select
            ActiveSheet.Paste
     
                   Sheet9.range("longtermactions1").Offset(1) = lsummary1value(bsum)
                   Sheet9.range("longtermteam1").Offset(1) = lTeam1value(bsum)
                   Sheet9.range("longtermresponsible1").Offset(1) = lresponsible1value(bsum)
                   Sheet9.range("longtermduedate1").Offset(1) = ldatewish1value(bsum)
                   Sheet9.range("longtermstatus1").Offset(1) = lstatus1value(bsum)
     
                 Application.ScreenUpdating = False
                GoTo passealasuite
     
         End If 'fin de la condition date
    passealasuite:

  2. #2
    Expert confirmé Avatar de jfontaine
    Homme Profil pro
    Contrôleur de Gestion
    Inscrit en
    Juin 2006
    Messages
    4 756
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 51
    Localisation : France, Sarthe (Pays de la Loire)

    Informations professionnelles :
    Activité : Contrôleur de Gestion

    Informations forums :
    Inscription : Juin 2006
    Messages : 4 756
    Par défaut
    Bonjour,

    Mon problème est qu’une fois ces lignes créées je souhaiterais faire un delete sur les lignes qui ont été ajoutées.
    tu ajoutes des lignes que tu supprimes ensuite
    Une idée à creuser, lors de l'ajout de ligne, tu mets un 1 dans la derni-re colonne de ta ligne.
    Ensuite tu supprimes les lignes qui ont ce 1 dans la dernière colonne

  3. #3
    Membre averti
    Inscrit en
    Juillet 2011
    Messages
    32
    Détails du profil
    Informations forums :
    Inscription : Juillet 2011
    Messages : 32
    Par défaut
    Salut et merci de ta réponse, ca devrait fonctionner avec ca .
    Enfait je mets des informations dans les lignes que j'ajoute puis j'envoie le tout sur Word et pour finir je reset mon "template"

  4. #4
    Membre averti
    Inscrit en
    Juillet 2011
    Messages
    32
    Détails du profil
    Informations forums :
    Inscription : Juillet 2011
    Messages : 32
    Par défaut
    Hello,

    J’ai un peu galéré mais c’est bon le code marche.

    Pour delete les lignes ajoutées il suffira d’aller chercher dans la colonne ou on insert les valeurs les lignes contenant cette valeur.

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    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
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
    77
    78
    79
    80
    81
    82
    83
    84
    85
    86
    87
    88
    89
    90
    91
    92
    93
    94
    95
    96
    97
    98
    99
    100
    101
    102
    103
    104
    105
    106
    107
    108
    109
    110
    111
    112
    113
    114
    115
    116
    117
    118
    119
    120
    121
    122
    123
    124
    125
    126
    127
    128
    129
    130
     
    Dim bsum As Integer, lRowType(15), lrowtypeValue(15), Summary1(15), lsummary1value(15), _
                         lTeam1(15), lTeam1value(15), lresponsible1(15), lresponsible1value(15), _
                         ldatewish1(15), ldatewish1value(15), lstatus1(15), lstatus1value(15), ltest(15)
     
    Dim bsum2 As Integer, ltest2(15)
    Dim bsum3 As Integer, ltest3(15)
    bsum2 = 1
    bsum3 = 1
          For bsum = 1 To 15
     
        Sheet1.Activate
        lRowType(bsum) = ActiveSheet.range("COL_ROWTYPE").Column
        lrowtypeValue(bsum) = ActiveSheet.range(Number2Char(lRowType(bsum)) & lrow + bsum).Value
     
    ltest(bsum) = "rowadelete"  'Variable qui va ajouter "rowadelete" dans la column "rowdelete"
    ltest2(bsum2) = "rowadelete"
    ltest3(bsum3) = "rowadelete"
     
    If lrowtypeValue(bsum) <> "P" Then
     
        Summary1(bsum) = ActiveSheet.range("COL_Summary").Column
        lsummary1value(bsum) = ActiveSheet.range(Number2Char(Summary1(bsum)) & lrow + bsum).Value
        lTeam1(bsum) = ActiveSheet.range("COL_ASSIGNEE_DEPT").Column
        lTeam1value(bsum) = ActiveSheet.range(Number2Char(lTeam1(bsum)) & lrow + bsum).Value
        lresponsible1(bsum) = ActiveSheet.range("COL_ASSIGNEE").Column
        lresponsible1value(bsum) = ActiveSheet.range(Number2Char(lresponsible1(bsum)) & lrow + bsum).Value
        ldatewish1(bsum) = ActiveSheet.range("COL_WISHDATE").Column
        ldatewish1value(bsum) = ActiveSheet.range(Number2Char(ldatewish1(bsum)) & lrow + bsum).Value
        lstatus1(bsum) = ActiveSheet.range("COL_STATUS").Column
        lstatus1value(bsum) = ActiveSheet.range(Number2Char(lstatus1(bsum)) & lrow + bsum).Value
     
    On Error GoTo passealasuite
    nbre_mois = ((Year(Date) - Year(ldatewish1value(bsum))) * 12) + Month(Date) - Month(ldatewish1value(bsum))
    nbre_mois = nbre_mois
    On Error GoTo passealasuite
     
        If lsummary1value(bsum) = Empty Or lsummary1value(bsum) = "" Then lsummary1value(bsum) = " -- "
        If lTeam1value(bsum) = Empty Or lTeam1value(bsum) = "" Then lTeam1value(bsum) = " -- "
        If lresponsible1value(bsum) = Empty Or lresponsible1value(bsum) = "" Then lresponsible1value(bsum) = " -- "
        If ldatewish1value(bsum) = Empty Or ldatewish1value(bsum) = "" Then ldatewish1value(bsum) = " -- "
        If lstatus1value(bsum) = Empty Or lstatus1value(bsum) = "" Then lstatus1value(bsum) = " -- "
     
        If ldatewish1value(bsum) = " -- " Then GoTo dt 'pas de date wish goto <1 mois
     
        If nbre_mois < 1 Then
    dt:
            Application.ScreenUpdating = False
            Sheet9.Activate
            Sheet9.range("Actionplan1").Offset(1, 0).Select
            Selection.Insert
            Sheet9.range("Actionplan1").Select
            Selection.Copy
            Sheet9.range("Actionplan1").Offset(1, 0).Select
            ActiveSheet.Paste
     
                   Sheet9.range("shorttermactions1").Offset(1) = lsummary1value(bsum)
                   Sheet9.range("shorttermteam1").Offset(1) = lTeam1value(bsum)
                   Sheet9.range("shorttermresponsible1").Offset(1) = lresponsible1value(bsum)
                   Sheet9.range("shorttermduedate1").Offset(1) = ldatewish1value(bsum)
                   Sheet9.range("shorttermstatus1").Offset(1) = lstatus1value(bsum)
                   Sheet9.range("shorttermstatus1").Offset((bsum), 3) = ltest(bsum) ' ligne qui ajoute le text "rowadelete" dans la column "rowdelete"
     
                 Application.ScreenUpdating = False
                GoTo passealasuite
     
         ElseIf nbre_mois >= 1 And nbre_mois < 3 Then
     
            Application.ScreenUpdating = False
            Sheet9.Activate
            Sheet9.range("Actionplan2").Offset(1, 0).Select
            Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
            Sheet9.range("Actionplan2").Select
            Selection.Copy
            Sheet9.range("Actionplan2").Offset(1, 0).Select
            ActiveSheet.Paste
     
        ltest2(bsum2) = "rowadelete"
     
                   Sheet9.range("shorttermactions2").Offset(1) = lsummary1value(bsum)
                   Sheet9.range("shorttermteam2").Offset(1) = lTeam1value(bsum)
                   Sheet9.range("shorttermresponsible2").Offset(1) = lresponsible1value(bsum)
                   Sheet9.range("shorttermduedate2").Offset(1) = ldatewish1value(bsum)
                   Sheet9.range("shorttermstatus2").Offset(1) = lstatus1value(bsum)
                   Sheet9.range("shorttermstatus2").Offset((bsum2), 3) = ltest2(bsum2)  ' ligne qui ajoute le text "rowadelete" dans la column "rowdelete"
                   bsum2 = bsum2 + 1
     
                 Application.ScreenUpdating = False
                GoTo passealasuite
     
        ElseIf nbre_mois >= 3 Then
     
            Application.ScreenUpdating = False
            Sheet9.Activate
            Sheet9.range("Actionplan3").Offset(1, 0).Select
            Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
            Sheet9.range("Actionplan3").Select
            Selection.Copy
            Sheet9.range("Actionplan3").Offset(1, 0).Select
            ActiveSheet.Paste
     
        ltest3(bsum3) = "rowadelete"
     
                   Sheet9.range("shorttermactions3").Offset(1) = lsummary1value(bsum)
                   Sheet9.range("shorttermteam3").Offset(1) = lTeam1value(bsum)
                   Sheet9.range("shorttermresponsible3").Offset(1) = lresponsible1value(bsum)
                   Sheet9.range("shorttermduedate3").Offset(1) = ldatewish1value(bsum)
                   Sheet9.range("shorttermstatus3").Offset(1) = lstatus1value(bsum)
                   Sheet9.range("shorttermstatus3").Offset((bsum3), 3) = ltest3(bsum3) ' ligne qui ajoute le text "rowadelete" dans la column "rowdelete"
                   bsum3 = bsum3 + 1
     
                 Application.ScreenUpdating = False
                GoTo passealasuite
     
         End If 'fin de la condition date
    passealasuite:
     
    Else    ' si lrowtypeValue(bsum) = "P"
                lsummary1value(bsum) = ""
                lTeam1value(bsum) = ""
                lresponsible1value(bsum) = ""
                ldatewish1value(bsum) = ""
                lstatus1value(bsum) = ""
     
                GoTo lasuite
     
    End If
    Next bsum
     
    lasuite:

+ Répondre à la discussion
Cette discussion est résolue.

Discussions similaires

  1. Réponses: 2
    Dernier message: 11/07/2012, 17h52
  2. différence de rows entre SQL server 2000 et 2005
    Par locus dans le forum Développement
    Réponses: 6
    Dernier message: 07/12/2011, 12h04
  3. Réponses: 3
    Dernier message: 10/10/2010, 22h22
  4. Somme de deux rows
    Par lokal64 dans le forum Développement de jobs
    Réponses: 3
    Dernier message: 03/07/2008, 14h30
  5. [debutant]ms sql serveur delete entre deux tables
    Par ChristopheOce dans le forum MS SQL Server
    Réponses: 2
    Dernier message: 01/06/2006, 16h36

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo