У меня есть столбец данных, который я хотел бы «отфильтровать», этот фильтр состоит из двух отдельных компонентов.
Шаг 1:
- Переместиться вниз через столбец данных
- Выявить пробелы в блоках данных
- Пробелы, меньшие, чем номинальное значение ячейки, заполняются значением 1
Шаг 2:
- Переместитесь вниз по тому же столбцу данных, что и шаг 1
- Определите группы данных, которые состоят из количества строк ниже, чем назначенное значение ячейки
- Блоки данных, которые меньше назначенного значения ячейки, удаляются
Я уже создал макрос, который заполняет пробелы в группе данных, которая меньше определенного значения ячейки (ячейки (1, 15).Значение), показано ниже.
Вот что у меня есть, я начал писать макрос для второго шага, но не смог обойти синтаксическую ошибку. Также показан ниже пример необработанных и отфильтрованных данных.
Синтаксическая ошибка - это одна вещь, я борюсь с тем, как выполнить второй шаг, поэтому помощь будет принята с благодарностью.
ура
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 Sub
Option 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 Sub
1 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