Фильтр данных столбца

2

У меня есть столбец данных, который я хотел бы «отфильтровать», этот фильтр состоит из двух отдельных компонентов.

Шаг 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
Sandie
источник
ваш макрос на самом деле выглядит намного сложнее, чем вы описали, также неясно, в чем именно заключается ваша проблема с ним. Пожалуйста, отредактируйте ваш вопрос, чтобы он был понятен и имел удобочитаемый размер.
Máté Juhász
Спасибо, Мате, я сделал несколько правок, так что, надеюсь, теперь все немного яснее.
Сэнди

Ответы:

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
Jonno
источник
@ Санди Нет проблем - когда вы счастливы, ваша проблема решена, не забудьте пометить ответ правильно с помощью галочки слева от ответа, который вам помог :)
Jonno
Спасибо Джонно, это было так полезно. Ваш код работает, хотя мне нужно добавить два дополнительных критерия к идентификатору. Они запрашивают, чтобы номинированный диапазон ячеек до и после блока был пустым перед удалением блока. If (i - startOfBlock) <= Cells (1, 15). Значение и Application.Sum (Range (Cells (i, iCol), Cells (i + Cells (1, 15) .Value, iCol))) = 0 Тогда - Этот дополнительный критерий работает, но второй, показанный ниже, не работает, так как я думаю, что он пытается посмотреть на строки перед Row1? And Application.Sum (Range (Ячейки (i-startofBlock, iCol), Ячейки (i-startofBlock - Ячейки (1, 15). Значение, iCol))) = 0
Сэнди
Да, он будет искать отрицательный ряд, который нельзя сделать. Вы можете добавить второй критерий в мой If (i - startOfBlock) < Cells(1, 15).Value Then, и сделать что-то вроде If i - startOfBlock - Cells(1, 15).Value > 0 Then следующей строки If Application.Sum(Range(Cells(i, iCol), Cells(i + Cells(1, 15).Value, iCol))) = 0 And Application.Sum(Range(Cells(i-startofBlock, iCol), Cells(i-startofBlock - Cells(1, 15).Value, iCol)))=0 Then удалить блок на End If следующей строке End If
Jonno
Еще раз спасибо, Джонно, это был не просто поиск в Google ответов, я ценю, что вы потратили на это время.
Сэнди
@ Санди Не проблема - я понятия не имею, чего вы пытаетесь достичь, но надеюсь, что это
сработает