ตัวกรองข้อมูลคอลัมน์

ฉันมีคอลัมน์ข้อมูลที่ฉันต้องการ 'กรอง' ตัวกรองนี้มีองค์ประกอบที่แตกต่างกันสองส่วน

ขั้นตอนที่ 1:

• เลื่อนลงไปตามคอลัมน์ข้อมูล
• ระบุช่องว่างในบล็อกของข้อมูล
• ช่องว่างน้อยกว่าค่าเซลล์ที่เสนอชื่อจะถูกเติมด้วยค่า 1

ขั้นตอนที่ 2:

• เลื่อนลงมาตามคอลัมน์ข้อมูลเดียวกันกับขั้นตอนที่ 1
• ระบุกลุ่มข้อมูลที่ประกอบด้วยจำนวนแถวที่ต่ำกว่าค่าเซลล์ที่เสนอ
• บล็อกของข้อมูลที่มีขนาดเล็กกว่าค่าเซลล์ที่ระบุจะถูกลบ

ฉันได้สร้างมาโครที่เติมช่องว่างในกลุ่มข้อมูลน้อยกว่าค่าเซลล์ที่แน่นอน (เซลล์ (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

ข้อผิดพลาดทางไวยากรณ์ของคุณคือบรรทัดนี้:

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