J'ai une colonne de données que je voudrais «filtrer», ce filtre a deux composants distincts.
Étape 1:
- Descendre dans une colonne de données
- Identifier les lacunes dans les blocs de données
- Les espaces inférieurs à une valeur de cellule désignée sont remplis avec une valeur de 1
Étape 2:
- Descendre dans la même colonne de données qu'à l'étape 1
- Identifier les groupes de données constitués d'un nombre de lignes inférieur à la valeur de cellule désignée
- Les blocs de données plus petits que la valeur de cellule désignée sont supprimés
J'ai déjà créé une macro qui comble les espaces vides dans un groupe de données d'une valeur inférieure à une certaine valeur de cellule (Cells (1, 15) .Value), illustrée ci-dessous.
Voici ce que j'ai jusqu'à présent. J'ai commencé à écrire une macro pour la deuxième étape mais je ne peux pas dépasser une erreur de syntaxe. Vous trouverez également ci-dessous un exemple de données brutes et filtrées.
L'erreur de syntaxe est une chose. Je me demande comment effectuer la deuxième étape, alors toute aide serait la bienvenue.
À votre santé
Option Explicit
Sub FillInTheBlanks()
'
' FillInTheBlanks Macro
'
'Declare integers and decimal characters
Dim iCol As Long, Last As Long, i As Long
Dim iBlank As Long, BlankMode As Boolean, iCount As Long
Dim j As Long, i1 As Long, iFullCount As Long 'Declare integers, boolean and decimal characters
iCol = ActiveCell.Column 'Column identified by active cell
Last = Cells(Rows.Count, iCol).End(xlUp).Row 'Determine end of nominated range
iBlank = 0 'iBlank starts at zero
iFullCount = 0 'iBlank starts at zero
BlankMode = False 'BlankMode starts as False
For i = 4 To Last 'Start at row 4 and go to the end of column
If BlankMode Then 'If the next cell is empty
If Cells(i, iCol) = "" Then
iBlank = iBlank + 1 'If an emty cell is detected increase iBlank by 1
iCount = iBlank 'Count the spaces
Else
For j = i1 To i - 1 And iCount < Cells(1, 15).Value
Cells(j, iCol).Value = 1
Next j
BlankMode = False
End If
Else
If Cells(i, iCol) = "" Then
iBlank = 1
i1 = i
BlankMode = True
End If
End If
Next i
End SubOption Explicit
Sub EraseSpikes()
'
'
'
'
Dim iCol As Long, Last As Long, i As Long
Dim iFullCount As Long
Dim p As Long
iCol = ActiveCell.Column
Last = Cells(Rows.Count, iCol).End(xlUp).Row
iFullCount = 0
For i = 4 To Last
If Cells(i, iCol) = 1 Then
iFullCount = iFullCount + 1
p = i
Else
If iFullCount < Cells(1, 15).Value And Sum(Range(Cells(p, iCol),Cells(p-Cells(1, 15).Value,iCol))=0 And Sum(Range(Cells(p+iFullCount, iCol),Cells(p+iFullCount(1, 15).Value,icol))=0
End If
End If
Next i
End Sub1 1 1
2 1 1
3 1 1
4 1 1
5 1 1
6 1 1
7 1 1
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24 1 1
25 1 1
26 1 1
27 1 1
28 1 1
29 1 1
30 1 1
31 1 1
32 1 1
33 1 1
34 1 1
35 1 1
36 1 1
37 1 1
38 1 1
39 1
40 1
41 1 1
42 1 1
43 1 1
44 1 1
45 1 1
46 1 1
47 1
48 1 1
49 1 1
50 1 1
51 1 1
52 1 1
53 1 1
54 1
55 1
56 1
57 1
58 1 1
59 1 1
60 1 1
61 1 1
62 1 1
63 1 1
64 1
65 1
66 1
67 1
68 1
69 1 1
70 1 1
71 1 1
72 1 1
73 1 1
74 1 1
75 1
76 1
77 1
78 1
79 1
80 1
81 1
82 1 1
83 1 1
84 1 1
85 1 1
86 1 1
87 1 1
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107 1
108 1
109 1
110 1
111 1
112 1
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137 1 1
138 1 1
139 1 1
140 1 1
141 1 1
142 1 1
143 1
144 1
145 1
146 1
147 1
148 1
149 1
150 1
151 1
152 1
153 1
154 1
155 1 1
156 1 1
157 1 1
158 1 1
159 1 1
160 1 1
votre macro semble en réalité beaucoup plus complexe que ce que vous avez décrit, et on ne sait pas non plus quel est votre problème exact. Veuillez modifier votre question pour la rendre claire et de taille digestible.
—
Máté Juhász
Merci Máté, j'ai apporté quelques modifications, alors j'espère que les choses sont un peu plus claires maintenant.
—
Sandie