Discussion :

[toniodelavega]

Bonjour,

voici mon code

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 MiseEnForme()
 
Dim i As Long
Dim a As Long
Dim NbreLigne As Long
 
 ' Insertion d'une colonne
 
    Range("A1").Resize(, 1).EntireColumn.Insert Shift:=xlToRight
 
  'Selection du numero de compte  
 
 
    If Cells(i, 5).Value Like "6*" Then
 
 
    For a = 0 To 5
 
        If Cells(i, 5).Value <> "" Then
 
        Cells(a + i + 2, 1).Value = Cells(i, 5).Value
 
        End If
 
    Next
 
    End If 
 
End Sub

je met en copie le fichier exemple pour visualiser le pb:

Je cherche à reformater une extraction d'un grand livre (comptabilité) et je voudrais avoir le numero de compte à coté de chacune de mes factures.
J'arrive à :

- inserer une ligne à gauche
- faire reconnaitre le numero de compte avec like "6*"
- copier ce numero de compte dans la nouvelle colonne à gauche de ma première facture dans ce compte

mais je n'arrive pas à le faire repeter cette action jusqu'a ce qu'il ait fini les factures de ce compte

j'aimerais bien aussi qu'il m'élimine les ligne qui ne sont pas des factures mais ça c'est accessoire puisqu'il est très facile de faire des filtres...

si quelqu'un peu me filer un petit coup de main .

merci beaucoup !!

ps: le 5 que j'utilise est arbitraire parceque je n'arrive pas à lui faire compter le nombre de ligne de facture pour chaque compte

[PPz78]

Bonsoir,

Pas trouvé le fichier en PJ
Il me semble que la variable i n'est pas initialisée.
Il existe aussi le mode "Debug" pour suivre ce qui se passe. Peux tu nous le décrire?

A+
PPz

[toniodelavega]

ok voici la pièce jointe

je pense pas que ce soit vraiment difficile mais j'ai pas trop piste pour rechercher.

a mon avis il faut que je crée une variable qui va stocker le nombre de factures par n° de compte comptable et de la recopier sur la gauche de chaque facture ce n° de compte...

encore merci

[PPz78]

Avec cela c'est mieux :

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
Sub InsertColonne()
 
Dim i As Long
 ' Insertion d'une colonne
 
    Range("A1").Resize(, 1).EntireColumn.Insert Shift:=xlToRight
 
    For i = 1 To 1500
        If Cells(i, 6).Value Like "6*" Then
            If Cells(i, 6).Value <> "" Then
                Cells(i, 1).Value = Cells(i, 6).Value
            End If
        End If
    Next
 
End Sub

[mercatog]

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
Sub Reformate()
Dim LastLig As Long, i As Long, j As Long
Dim tbDeb
 
Application.ScreenUpdating = False
ReDim tbDeb(0 To 1)
With Sheets("Facture")
    .AutoFilterMode = False
    If .Range("A1").Value <> "Compte" Then
        LastLig = .Cells(Rows.Count, "D").End(xlUp).Row
        For i = 2 To LastLig
            If Left(Trim(.Range("D" & i).Value), 1) = "6" Then
                j = j + 1
                ReDim Preserve tbDeb(1 To j)
                tbDeb(j) = i
            End If
        Next i
        .Columns(1).Insert
        .Range("A1").Value = "Compte"
        If UBound(tbDeb) > 1 Then
            For i = 1 To UBound(tbDeb) - 1
                .Range("A" & tbDeb(i) & ":A" & tbDeb(i + 1) - 1).Value = Trim(.Range("E" & tbDeb(i)).Value)
            Next i
            .Range("A" & tbDeb(UBound(tbDeb)) & ":A" & LastLig - 1).Value = Trim(.Range("E" & tbDeb(UBound(tbDeb))).Value)
            .Columns(1).AutoFit
            .Range("A1").AutoFilter Field:=3, Criteria1:="="
            If .Range("A1:A" & LastLig).SpecialCells(xlCellTypeVisible).Count > 1 Then
                .Range("A2:A" & LastLig).SpecialCells(xlCellTypeVisible).EntireRow.Delete
            End If
            .AutoFilterMode = False
        End If
    End If
End With
End Sub

[toniodelavega]

ça marche super bien !

merci beaucoup pour le coup de main, je vais bien comprendre le code pour continuer à avancer en VBA et être capable de l'adapter pour d'autres problèmes du genre

en tout cas encore un grand merci