VBA : traitement ligne par ligne

Version imprimable

03/04/2014, 14h13
dttpedt

1 pièce(s) jointe(s)

VBA : traitement ligne par ligne

Bonjour,

J’ai un fichier Excel auquel je dois modifier les valeurs d’une colonne sous conditions particulières.

Je souhaite modifier les valeurs de la colonne F.

Je m’explique, toutes les valeurs de la colonne F qui ont en colonne E les valeurs suivantes THOS 1:32 doivent passer par exemple de 3 à 1-3 sauf les lignes ou il y a en colonne F un ON. ON reste ON !

Une autre condition, toujours dans la colonne F, toutes les valeurs se trouvant au-dessus RAZ1 doivent passer par exemple de 3 à 1-3 et au-dessus d’RAZ2 de 3 à 2-3 par exemple.

Pour information, il y a toujours 32 lignes de valeur suivies soit de RAZ1 ou 2 soit ON.

Je ne sais pas si je suis bien claire mais voici m’a problématique. Je pensait réaliser le traitement par bloc de 32 lignes !

Pièce jointe 142036

Bonjour,

Une piste à adapter :

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
 
Sub Test()
 
    Dim Plage As Range
    Dim Cel As Range
    Dim I As String
 
    With Worksheets("Sheet1")
 
        Set Plage = .Range(.Cells(2, 6), .Cells(.Rows.Count, 6).End(xlUp))
 
    End With
 
    'pour éviter la mise au format Date
    Plage.NumberFormat = "@"
 
    'comme en début de plage il n'y a ni "RAZ1" ni "RAZ02", I sera à 1, à adapter
    I = 1
 
    For Each Cel In Plage
 
        'défini I en fonction de la valeur rencontrée
        If Cel.Value = "RAZ1" Then I = "2"
        If Cel.Value = "RAZ02" Then I = "1"
 
        'si la condition est remplie en colonne E et en colonne F
        If Cel.Offset(, -1).Value = "THOS 1:32" And Cel.Value <> "ON" Then
 
            Cel.Value = I & "-" & Cel.Value
 
        End If
 
    Next Cel
 
End Sub

Hervé.

Bon après avoir pas mal galéré, j'ai une solution qui fonctionne.

je la poste si quelqu'un comme moi en a besoin il faudra l'adapter.

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
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
89
90
91
92
93
94
95
96
 
Sub Export_import()
 
' traite les données de la colonne PN pour modifier le format en fct des colonnes E et des informations INPUT1 et 2.
 
' Déclaration variable
 
        Dim X As Range
        Dim Y As Range
        Dim Z As Range
        Dim dlX As Integer
        Dim dlY As Integer
        Dim dlZ As Integer
        Dim i As Long
        Dim t As Long
        Dim WB As Workbook
        Dim Nom_Fichier As Variant
        i = 32
 
' Ouverture d'une fenêtre de parcours pour aller chercher le fichier XLS à traiter
 
Nom_Fichier = Application.GetOpenFilename("Fichiers Excel (*.xlsx), *.xlsx")
If Nom_Fichier <> False Then
   Set WB = Workbooks.Open(Nom_Fichier)
  WB.Activate
End If
 
' Référencement de la colonne U pour les traitements
 
    Range("U1").Select
    ActiveCell.FormulaR1C1 = "THOS 1:32"
    Range("U2").Select
    ActiveCell.FormulaR1C1 = "THOS 2:64"
    Range("U3").Select
    ActiveCell.FormulaR1C1 = "INPUT1"
    Range("U4").Select
    ActiveCell.FormulaR1C1 = "INPUT2"
    Range("U5").Select
    ActiveCell.FormulaR1C1 = "1"
    Range("A1").Select
 
' modifie le format de la colonne Port name
        Range("U5").Select
        Selection.Copy
        Columns("F:F").Select
        Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlMultiply, _
        SkipBlanks:=False, Transpose:=False
 
' Trie de A à Z de la colonne ID
        Columns("A:S").Select
        Application.CutCopyMode = False
        Selection.AutoFilter
        ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort.SortFields.Clear
        ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort.SortFields.Add Key:= _
        Columns("A:A"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
        With ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
 
        dlX = Range("A1").CurrentRegion.End(xlDown).Row ' Defini le nb de ligne du tableau dans une variable
 
        For Each X In Range("E2:E" & dlX)
            If X = Range("U1") Then
                  X.Offset(0, 1).NumberFormat = "1-00"
            End If
        Next X
 
        dlY = Range("A1").CurrentRegion.End(xlDown).Row
 
        For Each Y In Range("F2:F" & dlY)
            If Y = Range("U3") Then
 
                For i = 32 To 1 Step -1
                 Y.Offset(-i, 0).NumberFormat = "1-00"
                Next i
            End If
        Next Y
 
        dlZ = Range("A1").CurrentRegion.End(xlDown).Row
 
        For Each Z In Range("F2:F" & dlZ)
            If Z = Range("U4") Then
 
                For t = 32 To 1 Step -1
 
                Z.Offset(-t, 0).NumberFormat = "2-00"
                Next t
            End If
        Next Z
 
End Sub

Voilà.

Bonjour,
sans aller plus loin, cette partie

Code:

1
2
3
4
5
6
7
8
9
10
11
12
...
 Range("U1").Select
    ActiveCell.FormulaR1C1 = "THOS 1:32"
    Range("U2").Select
    ActiveCell.FormulaR1C1 = "THOS 2:64"
    Range("U3").Select
    ActiveCell.FormulaR1C1 = "INPUT1"
    Range("U4").Select
    ActiveCell.FormulaR1C1 = "INPUT2"
    Range("U5").Select
    ActiveCell.FormulaR1C1 = "1"
...

devrait être remplacée par

Code:

1
2
3
4
5
Range("U1") = "THOS 1:32"
Range("U2") = "THOS 2:64"
Range("U3") = "INPUT1"
Range("U4") = "INPUT2"
Range("U5") = "1"

oublies les "Select"

Bonne journée