[Toutes versions] probleme de boucle

[lps02]

Bonjour
je suis nouveau sur le forum.
Mon probleme :
je rentre des donnees sur un carnet terrain. Je transferts apres les donnees en format texte sur le PC.(Onglet "donnees")
Je veux mettre en forme les données pour pouvoir les utiliser. (onglet "BD")
Je dois donc inserer d'abord chaque ligne de donnees (a partir de la deuxieme dans l'onglet feuille de saisie pour faire les calcul ou mise en forme)
je recopie résultat obtenu dans BD en inserant une ligne.
J'ai essayé de faire une macro qui fait toute l'opération (bouton "lancer enregistrement de données")
Je voudrais automatiser la tache pour chaque ligne de l'onglet "donnees" sachant que le nombre de ligne et de colonne peut evoluer selon les remarques faites sur le terrain; Par contre la presentation des donnees sera toujours la meme. voila la copie de ma 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
52
53
54
55
56
57
58
59
Sub lancer_le_transfert()
'
' lancer_le_transfert Macro
' saisie des données venant du terrain
'
 
'
    Sheets("IMPORT DU TERRAIN").Select
    Rows("2:2").Select
    Selection.Copy
    Sheets("Feuille de saisie").Select
    Rows("10:10").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("A10").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("A11").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Selection.TextToColumns Destination:=Range("A11"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
        :="-", FieldInfo:=Array(1, 1), TrailingMinusNumbers:=True
    Sheets("BD").Select
    Rows("2:2").Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Sheets("Feuille de saisie").Select
    Rows("2:2").Select
    Selection.Copy
    Sheets("BD").Select
    Rows("2:2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    ActiveWindow.ScrollColumn = 2
    ActiveWindow.ScrollColumn = 3
    Columns("R:R").Select
    Application.CutCopyMode = False
    Selection.NumberFormat = "m/d/yyyy"
    ActiveWindow.ScrollColumn = 2
    ActiveWindow.ScrollColumn = 1
    Range("A2").Select
    ActiveWorkbook.Worksheets("BD").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("BD").Sort.SortFields.Add Key:=Range("A2"), SortOn _
        :=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("BD").Sort
        .SetRange Range("A1:R2")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Sheets("Feuille de saisie").Select
    Rows("10:11").Select
    Selection.ClearContents
    Range("A8").Select
End Sub

Je vous ai joint le fichier.
Pouvez vous m'aider?
Je suis tres embete car besoin rapide pour mes collegues terrain.

[defluc]

Il y a du boulot et des connaissances à acquérir mais, cela fait, ce sera simple.

Pour commencer, 2 principes.
1. - Recueillir les valeurs des plages et des cellules sans utiliser la sélection
2. - Utiliser systématiquement les numéros de lignes et de colonnes pour que le programme puisse exécuter des boucles quel que soit le nombre de lignes et de colonnes

Fais une recherche sur UsedRange pour connaître la dernière ligne ou colonne.

Bon travail

[Theze]

Bonjour,

Comme le dit si bien Defluc, il faut éviter autant que possible d'effectuer des sélections, que ce soit de feuilles ou de ranges, ça fait scintiller l'écran et fortement ralentir l'exécution du code.
Pour définir une plage, tu peux tester la fonction "Plage" qui suit. Elle demande deux arguments. Le premier, la feuille sur laquelle tu veux travailler et le second, si tu veux que la fonction te retourne la plage à partir de A1 (même si la cellule est vide) ou alors à partir de la première cellule non vide en commençant par A1. Exécute la Sub "Test" ci-dessous en adaptant le nom de la feuille et en changeant la valeur (True ou False) de l'argument "Milieu" pour voir le résultat :

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
 
Function Plage(Fe As Worksheet, _
               Milieu As Boolean) As Range
 
    With Fe
 
        If Milieu = False Then
 
            'si "Milieu" est False, la plage est définie à partir de A1
            Set Plage = .Range(.Cells(1, 1), _
                        .Cells( _
                        .Cells.Find("*", .[A1], -4123, , _
                        1, 2).Row, _
                        .Cells.Find("*", .[A1], -4123, , _
                        2, 2).Column))
 
        Else
 
            'Sinon, la plage est définie à partir de la première cellule non vide
            'de la feuille (en partant d'en haut à gauche) jusqu'à la dernière utilisée
            Set Plage = .Range(.Cells( _
                        .Cells.Find("*", .Range("A" & .Rows.Count), -4123, , _
                        1, 1).Row, _
                        .Cells.Find("*", .Range("A" & .Rows.Count), -4123, , _
                        2, 1).Column), _
                        .Cells( _
                        .Cells.Find("*", .[A1], -4123, , _
                        1, 2).Row, _
                        .Cells.Find("*", .[A1], -4123, , _
                        2, 2).Column))
 
        End If
 
    End With
 
End Function
 
Sub Test()
 
    Dim Pl As Range
 
    'False = A1 inclu, True = 1ère cellule trouvée en partant de A1
    Set Pl = Plage(Worksheets("Feuil1"), True)
 
    MsgBox "Adresse de la plage : " & Pl.Address(0, 0) & _
            vbCrLf & _
            "Nombre de lignes : " & Pl.Rows.Count & _
            vbCrLf & _
            "Nombre de colonnes : " & Pl.Columns.Count
 
End Sub

Hervé.

[lps02]

Merci pour votre aide; j'essaie et vous tiens au courant