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 :

Découpage si cellule >= 61 [XL-2000]


Sujet :

Macros et VBA Excel

Vue hybride

Message précédent Message précédent   Message suivant Message suivant
  1. #1
    Membre éclairé
    Homme Profil pro
    Assistant technique
    Inscrit en
    Février 2007
    Messages
    336
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 44
    Localisation : France, Seine Saint Denis (Île de France)

    Informations professionnelles :
    Activité : Assistant technique
    Secteur : Services à domicile

    Informations forums :
    Inscription : Février 2007
    Messages : 336
    Par défaut Découpage si cellule >= 61
    Bonjour,

    Actuellement j'essaie de faire cette macro :

    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
    Sub test()
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
     
    Dim c As Integer
     
    For Each c In Range("F:F")
    'en sachant que la valeur maximale de la cellule doit être 60
    'donc
     
    If c >= 61 And c <= 120 Then
    'le découpage va se faire en 2
     
    '1) inserer une ligne juste en dessous
    '2) copier/coller toute la ligne c sur la ligne qui a été inserer
    '3) si on a par exemple on a la valeur 70, ça sera 60 en première ligne, puis 10 en deuxième ligne
     
    If c >= 121 Then
    'le découpage va se faire en 3
     
    If c >= 181 Then
    'le découpage va se faire en 4
     
    'et ainsi de suite
     
     
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    End Sub

    Première question : comment faire ça ? (le fait que si on a par exemple 70, alors il met 60 en première ligne, et le reste (10) en deuxième ligne)

    Deuxième question : peut-on faire plus simple que ce que j'ai fait ?


    Merci par avance

  2. #2
    Expert éminent Avatar de mercatog
    Homme Profil pro
    Inscrit en
    Juillet 2008
    Messages
    9 435
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : Autre

    Informations forums :
    Inscription : Juillet 2008
    Messages : 9 435
    Par défaut
    Bonjour,
    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
    Sub Test()
    Dim LastLig As Long, i As Long
    Dim nbLig As Byte, j As Integer
    Application.ScreenUpdating = False
    With Sheets("Feuil3")         'à adapter
        LastLig = .Cells(Rows.Count, "F").End(xlUp).Row
        For i = LastLig To 2 Step -1
            nbLig = (.Range("F" & i).Value - 1) \ 60
            If nbLig > 0 Then
                .Rows(i).Copy
                .Rows(i & ":" & i + nbLig - 1).Insert
                Application.CutCopyMode = False
                For j = 0 To nbLig
                    If j = nbLig Then
                        .Range("F" & i + j).Value = .Range("F" & i + j).Value - 60 * nbLig
                    Else
                        .Range("F" & i + j).Value = 60
                    End If
                 Next j
            End If
        Next i
    End With
    End Sub

  3. #3
    Membre chevronné
    Profil pro
    Inscrit en
    Décembre 2008
    Messages
    389
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : Décembre 2008
    Messages : 389
    Par défaut
    Bonjour,

    un essai

    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
    Sub test()
    Dim c As Range
    Dim a
    Dim b
     
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
     
     
        For Each c In Range("F:F")
            If c >= 61 Then
            a = c.Row
            b = c.Value
            Rows(a).Copy
            Rows(a).Insert shift:=xlDown
            c.Offset(-1) = 60
            c = b - 60
            End If
        Next c
     
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    End Sub

  4. #4
    Membre éclairé
    Homme Profil pro
    Assistant technique
    Inscrit en
    Février 2007
    Messages
    336
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 44
    Localisation : France, Seine Saint Denis (Île de France)

    Informations professionnelles :
    Activité : Assistant technique
    Secteur : Services à domicile

    Informations forums :
    Inscription : Février 2007
    Messages : 336
    Par défaut
    Merci à vous deux, ça fonctionne !!!!!

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

Discussions similaires

  1. Découpage contenu d'une cellule en x colonnes
    Par Grankiller33 dans le forum Excel
    Réponses: 4
    Dernier message: 06/05/2015, 13h12
  2. [XL-2007] Découpage de cellules contenant des retours chariots
    Par steelk dans le forum Macros et VBA Excel
    Réponses: 7
    Dernier message: 17/10/2014, 13h55
  3. Découpage de l'ensemble de cellules
    Par airballman dans le forum MATLAB
    Réponses: 5
    Dernier message: 30/06/2010, 14h24
  4. Découpage d'un tableau de cellules en sous-tableaux
    Par sseneor dans le forum MATLAB
    Réponses: 19
    Dernier message: 17/09/2007, 23h01
  5. [VBA-E] [Excel] Protection d'une plage de cellules
    Par fikou dans le forum Macros et VBA Excel
    Réponses: 3
    Dernier message: 20/11/2002, 11h28

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