Filtro de dados da coluna

2

Eu tenho uma coluna de dados que gostaria de "filtrar", esse filtro tem dois componentes distintos.

Etapa 1:

  • Mover para baixo através de uma coluna de dados
  • Identifique lacunas em blocos de dados
  • Gaps menores que o valor de uma célula nomeada são preenchidos com um valor de 1

Etapa 2:

  • Percorra a mesma coluna de dados do Passo 1
  • Identifique grupos de dados que consistem em uma quantidade de linhas menor que o valor da célula nomeada
  • Blocos de dados menores que o valor da célula nomeada são excluídos

Eu já criei uma macro que preenche os intervalos em um grupo de dados com menos de um determinado valor de célula (Células (1, 15) .Value), mostrado abaixo.

Aqui está o que eu tenho até agora, comecei a escrever uma macro para a segunda etapa, mas não consegui passar por um erro de sintaxe. Também é mostrado abaixo um exemplo de dados brutos e filtrados.

O erro de sintaxe é uma coisa, estou com dificuldades em como executar o segundo passo, então a ajuda seria apreciada.

Felicidades

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
    
por Sandie 11.03.2016 / 12:44

1 resposta

2

Seu erro de sintaxe é com esta linha:

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

Quebrando:

Sum(Range(Cells(p, iCol),Cells(p-Cells(1, 15).Value,iCol))

Você está faltando colchetes e Sum não é uma função do VBA. Em vez disso, você usaria Application.Sum

Eu escrevi de forma um pouco diferente com base no que eu acredito que você realmente precisa. Deixe-me saber se isso funciona para você.

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
    
por 11.03.2016 / 13:37