Tôi có một cột dữ liệu mà tôi muốn 'lọc', bộ lọc này có hai thành phần riêng biệt.
Bước 1:
- Di chuyển xuống qua một cột dữ liệu
- Xác định các khoảng trống trong các khối dữ liệu
- Các khoảng trống nhỏ hơn một giá trị ô được chỉ định được điền với giá trị 1
Bước 2:
- Di chuyển xuống qua cùng một cột dữ liệu như Bước 1
- Xác định các nhóm dữ liệu bao gồm số lượng hàng thấp hơn giá trị ô được chỉ định
- Các khối dữ liệu nhỏ hơn giá trị ô được chỉ định sẽ bị xóa
Tôi đã tạo một macro lấp đầy các khoảng trống trong một nhóm dữ liệu nhỏ hơn một giá trị ô nhất định (Các ô (1, 15). Giá trị), được hiển thị bên dưới.
Đây là những gì tôi có cho đến nay, tôi đã bắt đầu viết một macro cho bước thứ hai nhưng không thể vượt qua lỗi cú pháp. Cũng hiển thị dưới đây là một ví dụ về dữ liệu thô và được lọc.
Lỗi cú pháp là một điều, tôi đang vật lộn với cách thực hiện bước thứ hai, vì vậy sự giúp đỡ sẽ được đánh giá cao.
Chúc mừng
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