Sujet Précédent Sujet Suivant

[Catégorie modifiée VB6 --> VBA] Ajout colonne dans une macro

diabolo141077 Messages postés 8 Date d'inscription mardi 13 octobre 2009 Statut Membre Dernière intervention 11 octobre 2010 - 5 oct. 2010 à 21:34
diabolo141077 Messages postés 8 Date d'inscription mardi 13 octobre 2009 Statut Membre Dernière intervention 11 octobre 2010 - 8 oct. 2010 à 05:51
Bonjour,

J'utilise une macro en VBA mais il me manque des éléments pour la rendre exploitable.

Actuellement la macro exporte des données "text et valeur" basée sur 1 colonne
j'aimerai exporter "text&Valeur" d' une deuxieme colonne mais je ne sais pas comment adapter la macro.
quelqu'un pour un petit coup de pouce?Merci 

Sub Macro1()
'
' Macro1 Macro
'

'
    ActiveCell.FormulaR1C1 = "=COUNTIF(R[-506]C[5]:R[-6]C[5],""<>""&""-"")"
End Sub


Sub Exporter_cmde()
Dim objcible As Workbook, objsource As Workbook
Dim cel As Variant, c As Long, dli As Long, nblp As Long
Dim table()
Dim result
Set objsource = Workbooks("Gestion sortie.xls")
Set objcible = Workbooks("Sortie.xls")

Application.ScreenUpdating = False
With objsource.Sheets(1)
dli = objsource.Sheets(1).Cells(Columns(1).Cells.Count, 1).End(xlUp).Row
nblp = WorksheetFunction.CountIf(.Range("G10:G" & dli), ("<>" & "-"))
ReDim table(nblp - 1, 2): c = 0

For Each cel In .Range("G10:G" & dli)
    If cel.Value <> "-" Then
        table(c, 0) = cel.Text
        table(c, 2) = cel.Offset(0, 54).Value
        c = c + 1
    End If
Next cel
End With
objcible.Sheets(1).Range("pladatsort").ClearContents
objcible.Sheets(1).Range("A4:C" & nblp + 3) = table
Set objcible = Nothing
Set objsource = Nothing
Application.ScreenUpdating = True

MsgBox ("La fiche de sortie est complétée!")
End Sub

4 réponses

Réponse 1 / 4
cs_loulou69 Messages postés 672 Date d'inscription mercredi 22 janvier 2003 Statut Membre Dernière intervention 2 juin 2016 1
6 oct. 2010 à 10:48
A lire rapidement l'algorithme

Dans la premiere feuile du fichier source
On regarde les lignes entre la 10 ème et la dernière qui ont dans la colonne G autre chose que "-" (on saute les lignes correspondantes) et on recopie les textes et valeurs dans la première feuille du fichier cible en A4:C


dli = nombre de ligne du fichier source
nblp = nombre de ligne du tableau cible répondant à la condition colonne <> "-"

pour rajouter des colonnes dans le tableau table

refaire l'instruction Redim
ex: ReDim table(nblp - 1, 4)

Ajouter des lignes dans la boucle for each cel

table(c, 3) = cel.Text
table(c, 4) = cel.Offset(0, xxxx).Value


Changer la recopie de destination

objcible.Sheets(1).Range("A4:C" & nblp + 3) = table

avec

objcible.Sheets(1).Range("A4:E" & nblp + 3) = table
0
Réponse 2 / 4
diabolo141077 Messages postés 8 Date d'inscription mardi 13 octobre 2009 Statut Membre Dernière intervention 11 octobre 2010
7 oct. 2010 à 06:06
Bonjour,

Merci pour ta réponse.

Si j'ai bien compris ton explication, on remplace les données.
Moi j'aimerais "ajouter" des données, c'est à dire prendre d'autres valeurs et les recopier sur une autres colonnes...
Si je fait l'exemple ci dessous ben ca ne marche pas
ReDim table(nblp - 1, 2): c = 0

For Each cel In .Range("G10:G" & dli)
    If cel.Value <> "-" Then
        table(c, 0) = cel.Text
        table(c, 2) = cel.Offset(0, 53).Value
        c = c + 1
ReDim table(nblp - 1, 4): c = 0

For Each cel In .Range("G10:G" & dli)
    If cel.Value <> "-" Then
        table(c, 0) = cel.Text
        table(c, 3) = cel.Offset(0, 54).Value
        c = c + 1
0
Réponse 3 / 4
cs_loulou69 Messages postés 672 Date d'inscription mercredi 22 janvier 2003 Statut Membre Dernière intervention 2 juin 2016 1
7 oct. 2010 à 08:01
Bonjour

déjà le deuxième Redim réinitialise tout le tableau, il faut

Redim Preserve table(nblp - 1, 4): c = 0
...

Pour conserver le bénéfice de la premiere boucle for each
0
Réponse 4 / 4
diabolo141077 Messages postés 8 Date d'inscription mardi 13 octobre 2009 Statut Membre Dernière intervention 11 octobre 2010
8 oct. 2010 à 05:51
Bonjour,

Bon ben j'ai essayer de l'integrer comme ceci mais ca fonctionne toujours pas: instruction "For..."deja utiliser!! 

Sub Exporter_cmde()
Dim objcible As Workbook, objsource As Workbook
Dim cel As Variant, c As Long, dli As Long, nblp As Long
Dim table()
Dim result
Set objsource = Workbooks("Gestion sortie.xls")
Set objcible = Workbooks("Sortie.xls")

Application.ScreenUpdating = False
With objsource.Sheets(1)
dli = objsource.Sheets(1).Cells(Columns(1).Cells.Count, 1).End(xlUp).Row
nblp = WorksheetFunction.CountIf(.Range("G10:G" & dli), ("<>" & "-"))
ReDim table(nblp - 1, 2): c = 0

For Each cel In .Range("G10:G" & dli)
    If cel.Value <> "-" Then
        table(c, 0) = cel.Text
        table(c, 2) = cel.Offset(0, 53).Value
        c = c + 1
ReDim Preserve table(nblp - 1, 4): c = 0

For Each cel In .Range("G10:G" & dli)
    If cel.Value <> "-" Then
        table(c, 0) = cel.Text
        table(c, 4) = cel.Offset(0, 54).Value
        c = c + 1
    
    End If
Next cel
End With
objcible.Sheets(1).Range("pladatsort").ClearContents
objcible.Sheets(1).Range("A4:C" & nblp + 3) = table
Set objcible = Nothing
Set objsource = Nothing
Application.ScreenUpdating = True

MsgBox ("La fiche de sortie est complétée!")
End Sub
0

Discussions similaires

Ajouter une colonne
cavalier2400 -
cavalier2400 -

3 réponses
Ajout d'une colonne de type non null
cs_RMI -
Antoine Crochet-Damais -

5 réponses
Dernière cellule non vide d'une colonne
cs_falafala -
Luigi13013 -

5 réponses
Selection derniere cellule non vide plage cellule Excel
gregfred8cs -
pile_poil -

2 réponses
Derniere cellule remplie d'une colonne
Poluy -
jordane45 -

4 réponses
Rejoignez-nous