VBA : Remise en Forme d'une extraction .CSV

Version imprimable

1 pièce(s) jointe(s)

Bonjour,

J'ai quelques soucis venant de débuter avec VBA.

J'ai une extraction d'un logiciel qui se fait en .CSV, du coup pour l'analyser sur excel, je dois la "remettre en forme" (fichier attaché) pour pouvoir l'analyser.

Il faudrait que j'arrive à coder :
si la cellule est vide => aller chercher la prochaine cellule sur la ligne non vide, la couper et la coller dans la cellule vide testée.

J'ai commencé à coder ceci, la boucle fonctionne sur les lignes mais pas sur les colonnes, pourriez vous m'aider à améliorer cette macro ? :

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
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
Sub test()
 
 
Dim L As Long
Dim C As Long
 
 
C = 0
 
Do
C = C + 1
 
L = 0
    Do
        L = L + 1
 
        If IsEmpty(Cells(L, C)) And Cells(L, C + 1).Value <> 0 Then 'si la cellule est vide et que celle d'à coté est pleine
                 Cells(L, C + 1).Cut
                 Cells(L, C).Select
                  ActiveSheet.Paste
         End If
 
 
         If IsEmpty(Cells(L, C)) And IsEmpty(Cells(L, C + 1)) And Cells(L, C + 2).Value <> 0 Then
                       Cells(L, C + 2).Cut
                      Cells(L, C).Select
                      ActiveSheet.Paste
         End If
 
 
        If IsEmpty(Cells(L, C)) And IsEmpty(Cells(L, C + 1)) And IsEmpty(Cells(L, C + 2)) And Cells(L, C + 3).Value <> 0 Then
                        Cells(L, C + 3).Cut
                        Cells(L, C).Select
                        ActiveSheet.Paste
 
        End If
 
        If IsEmpty(Cells(L, C)) And IsEmpty(Cells(L, C + 1)) And IsEmpty(Cells(L, C + 2)) And IsEmpty(Cells(L, C + 3)) And Cells(L, C + 4).Value <> 0 Then
                        Cells(L, C + 4).Cut
                        Cells(L, C).Select
                        ActiveSheet.Paste
 
        End If
 
 
        Loop Until Cells(L, C).Value = "finligne" 'a voir comment arréter en automatique
 
Loop Until Cells(L, C).Value = "fincolonne" 'a voir comment arréter en automatique
 
 
End Sub

Je pense qu'il doit y avoir bien plus simple mais n'étant pas familier avec toutes les boucles possibles ...

Un grand merci à toutes les âmes charitables qui voudront bien m'aider !

Salut, à adapter à ton contexte peut-être

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
36
37
38
39
40
41
Option Explicit
 
Sub SelectionCsv()
Dim Fichier As Variant
    ChDir ThisWorkbook.Path
    Fichier = Application.GetOpenFilename("Fichier CSV (*.csv), *.csv")
    If Fichier <> False Then Lire Fichier
End Sub
 
Private Sub Lire(ByVal NomFichier As String)
Dim sChaine As String
Dim Ar() As String
Dim i As Long
Dim iRow As Long, iCol As Long
Dim NumFichier As Integer
Dim Separateur As String * 1
 
    Separateur = ";"
    ShDatas.Cells.Clear
    Application.ScreenUpdating = False
    NumFichier = FreeFile
 
    iRow = 0
 
    Open NomFichier For Input As #NumFichier
        Do While Not EOF(NumFichier)
            iCol = 1
            iRow = iRow + 1
            Line Input #NumFichier, sChaine
            Ar = Split(sChaine, Separateur)
            For i = LBound(Ar) To UBound(Ar)
                If Len(Ar(i)) > 0 Then
                    ShDatas.Cells(iRow, iCol) = Ar(i)
                    iCol = iCol + 1
                End If
            Next i
            Application.StatusBar = iRow
        Loop
    Close #NumFichier
    Application.ScreenUpdating = True
End Sub

30/03/2010, 16h29
yannbertrand

Merci pour le coup de main !

Je regarde ca, et je vous tiens au courant