我有一列想要“过滤”的数据，这个过滤器有两个不同的组件。
步骤1：
- 向下移动一列数据
- 识别数据块中的间隙
- 小于指定单元格值的间隙将用值 1 填充
第2步：
- 向下移动与步骤 1 相同的数据列
- 识别由低于指定单元格值的行数组成的数据组
- 小于指定单元格值的数据块将被删除
我已经创建了一个宏，它可以填充小于某个单元格值 (Cells(1, 15).Value) 的数据组中的空白，如下所示。
这是我目前所拥有的，我已经开始为第二步编写宏，但无法解决语法错误。下面还显示了原始数据和过滤数据的示例。
语法错误是一回事，我正在努力弄清楚如何执行第二步，因此如果能得到帮助我将非常感激。
干杯
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
答案1
您的语法错误在于这一行：
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
具体来说：
Sum(Range(Cells(p, iCol),Cells(p-Cells(1, 15).Value,iCol))
你缺少括号，并且Sum不是 VBA 函数。相反，你应该使用Application.Sum
我根据自己的想法写了些许不同相信你确实需要。如果这对你有用，请告诉我。
Sub EraseSpikes()
'
'
'
'
Dim iCol As Long, Last As Long, i As Long, j As Integer, startOfBlock As Integer
startOfBlock = -1 'Initialise startOfBlock. -1 means we're not in a block yet
iCol = ActiveCell.Column
Last = Cells(Rows.Count, iCol).End(xlUp).Row
For i = 4 To Last 'Begin loop from row 4 (?) to the end
If Cells(i, iCol) = 1 Then 'If we find a 1...
If startOfBlock = -1 Then 'And the block hasn't yet been started...
startOfBlock = i 'Mark this line as the start of our block
End If
Else 'If we don't find a 1...
If startOfBlock = -1 Then 'And we're not in a block...
GoTo nextLoop: 'We skip the rest of this until we're in a block
End If
If (i - startOfBlock) < Cells(1, 15).Value Then 'We didn't skip, so we're in a block.
'we check if (current row number - start row number)
'is less than the value in Cell(1,15) (Not equal to?)
For j = startOfBlock To i 'It was, so we loop through all the rows in that block blanking them
Cells(j, iCol).Value = ""
Next j
End If
startOfBlock = -1 'Reset to not being in a block
End If
nextLoop:
Next i
End Sub