demande d'aide pour modification d'une macro

**personalités** · 29/07/2015, 09h40

Bonjour

J'ai un souci pouvez vous m'aider?

Moi ce que je voulais c’était que s’il y avait ne serait ce qu’une info dans (c9 :c1000) que la macro me restitue les données en D et ainsi de suite

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
'Restitution des données
    Windows(F1).Activate
    For i = 1 To NbFeuilDep
Debut:
        On Error Resume Next
        If Left(FeuilDep(i), 4) = "INFO" Then GoTo Suivant
        For j = 1 To NbLig(i)
            If N°Comm(i, j) = "" Then GoTo Suivant
            Set c = Sheets(FeuilDep(i)).Columns("A").Find(N°Comm(i, j), LookIn:=xlValues)
            If Err.Number = 0 Then
                If Not c Is Nothing Then
                    Dec = 1
                    Do While c.Offset(0, Dec + 1) <> ""
                        Dec = Dec + 1
                    Loop
                    c.Offset(0, Dec + 1) = Abs(Montant(i, j))
                Else
                    Cells([A100000].End(xlUp).Row + 1, 1) = N°Comm(i, j)
                    Cells([A100000].End(xlUp).Row, 2) = NomComm(i, j)
                    Cells([A100000].End(xlUp).Row, 3) = Abs(Montant(i, j))
                End If
            Else
                GoTo CreerFeuille
            End If

Merci de votre aide

**Thautheme** · 29/07/2015, 10h28

Bonjour Personalités, bonjour le forum,

Code incomplet ! Il manque la fin des boucles For : Next i et Next j. Manque les étiquettes Suivant et CreerFeuille.
Il est possible que ce bout de code soit largement suffisant pour t'aider à résoudre ton problème mais je t'avoue que sans avoir une vue d'ensemble j'ai du mal à répondre...

**personalités** · 29/07/2015, 11h25

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
Option Compare Text
 
 
Sub ImportDonnees()
    Application.ScreenUpdating = False
    Dim i As Integer, j As Integer
    F1 = "fichier d'arrivée.xlsm"
    F2 = "informations de départ.xlsx"
 
'******************************************************************************************
    'Relevé des données
    Windows(F2).Activate
    NbFeuilDep = Sheets.Count
    ReDim FeuilDep(100) As String
    ReDim NbLig(10000) As Long
    ReDim N°Comm(NbFeuilDep, 100000) As String
    ReDim NomComm(NbFeuilDep, 100000) As String
    ReDim Montant(NbFeuilDep, 100000) As Double
 
    For i = 1 To NbFeuilDep
        FeuilDep(i) = Sheets(i).Name
        If Left(FeuilDep(i), 4) <> "INFO" Then
            NbLig(i) = Sheets(FeuilDep(i)).[A100000].End(xlUp).Row
            For j = 1 To NbLig(i)
                N°Comm(i, j) = Sheets(FeuilDep(i)).Cells(j, 3)
                NomComm(i, j) = Sheets(FeuilDep(i)).Cells(j, 4)
                Montant(i, j) = Sheets(FeuilDep(i)).Cells(j, 7)
            Next j
        Else
            N°Comm(i, j) = ""
        End If
    Next i
 
'******************************************************************************************
    'Restitution des données
    Windows(F1).Activate
    For i = 1 To NbFeuilDep
Debut:
        On Error Resume Next
        If Left(FeuilDep(i), 4) = "INFO" Then GoTo Suivant
        For j = 1 To NbLig(i)
            If N°Comm(i, j) = "" Then GoTo Suivant
            Set d = Sheets(FeuilDep(i)).Columns("A").Find(N°Comm(i, j), LookIn:=xlValues)
            If Err.Number = 0 Then
                If Not d Is Nothing Then
                    Dec = 1
                    Do While d.Offset(0, Dec + 1) <> ""
                        Dec = Dec + 1
                    Loop
                    d.Offset(0, Dec + 1) = Abs(Montant(i, j))
                Else
                    Cells([A100000].End(xlUp).Row + 1, 1) = N°Comm(i, j)
                    Cells([A100000].End(xlUp).Row, 2) = NomComm(i, j)
                    Cells([A100000].End(xlUp).Row, 4) = Abs(Montant(i, j))
                End If
            Else
                GoTo CreerFeuille
            End If
        Next j
 
        'Tri sur colonne A
        DerLig = [A8].End(xlDown).Row
        Range("A8:N" & DerLig).Select
        ActiveWorkbook.Worksheets(FeuilDep(i)).Sort.SortFields.Clear
        ActiveWorkbook.Worksheets(FeuilDep(i)).Sort.SortFields.Add Key:=Range("A8:A" & DerLig), _
            SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        With ActiveWorkbook.Worksheets(FeuilDep(i)).Sort
            .SetRange Range("A8:N" & DerLig)
            .Header = xlNo
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
Suivant:
    Next i
    Exit Sub
'******************************************************************************************
 
CreerFeuille:
    Sheets.Add
    ActiveSheet.Name = FeuilDep(i)
    [A1] = "Mettre : ""Section""+ nom de l'onglet"
    Range("C6:N6").Value = Array("Janvier", "Février", "Mars", "Avril", "Mai", "Juin", "Juillet", "Août", "Septembre", "Octobre", "Novembre", "Décembre")
     Range("A7:B7").Value = Array("N°COMMERCIAL", "NOM COMMERCIAL")
    On Error GoTo 0
    GoTo Debut
End Sub

**Thautheme** · 29/07/2015, 11h48

Re,

Du coup c'est ta question que je ne comprends plus ?! Pourquoi la colonne C ?...

**joe.levrai** · 29/07/2015, 13h22

Bonjour,

mêmeS remarqueS que Thauthème, le code est difficilement interprétable sur la question que tu poses

je me concentre donc sur la question, qui là encore n'est pas claire, deux interprétations possibles

Moi ce que je voulais c’était que s’il y avait ne serait ce qu’une info dans (c9 :c1000) que la macro me restitue les données en D et ainsi de suite

il s'agit donc de regarder si une cellule de la colonne C contient des valeurs (entre la ligne 9 et 1000) ... et si c'est le cas :
1) récupérer la valeur de la cellule située en colonne D et sur la même ligne ?
2) écrire en colonne D la valeur de C quand c'est pas vide ?

un exemple pour le point 1 à totalement adapter, c'est juste la mécanique.
pour le point 2, c'est encore plus simple, et l'exemple ci-dessous (basé sur le point 1) est très facilement adaptable à cette situation

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
Sub ioi()
Dim Tableau()
Dim i As Long
 
' transmet la plage C9:D1000 à un tableau VBA
Tableau = Feuil1.[C9:D1000].Value
 
' on affiche le nombre de cellules non vides de la colonne C
MsgBox Application.WorksheetFunction.Count(Tableau, 1)
 
' inspection de toutes les valeurs de la colonne C
For i = LBound(Tableau, 1) To UBound(Tableau, 1)
    ' écrire la valeur de la colonne D si la colonne C n'est pas vide
    ' on écrit le résultat dans la fenêtre d'execution
    If Tableau(i, 1) <> "" Then Debug.Print "Données en C" & i + 8 & " || Valeur en D" & i + 8 & " : " & Tableau(i, 2)
Next i
 
End Sub

**personalités** · 29/07/2015, 14h58

Bonjour

Merci de votre aide
je me rends compte que je me suis très mal expliqué :
alors je me permets de joindre des PJ à ma demande :

informations de départ.xlsx
fichier d'arrivée.xlsx

demande d'aide pour modification d'une macro

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager