Cột lọc dữ liệu


2

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

macro của bạn thực sự trông phức tạp hơn nhiều so với bạn mô tả, cũng không rõ đó là vấn đề chính xác của bạn với nó. Vui lòng chỉnh sửa câu hỏi của bạn để làm cho nó rõ ràng và có kích thước dễ tiêu hóa.
Máté Juhász

Cảm ơn Máté, tôi đã thực hiện một số chỉnh sửa vì vậy hy vọng mọi thứ đã rõ ràng hơn một chút.
Sandie

Câu trả lời:


1

Lỗi cú pháp của bạn là với dòng này:

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

Phá vỡ nó:

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

Bạn đang thiếu dấu ngoặc và Sumkhông phải là chức năng VBA. Thay vào đó, bạn sẽ sử dụngApplication.Sum

Tôi đã viết nó hơi khác nhau dựa trên những gì tôi tin rằng bạn thực sự cần. Hãy cho tôi biết, nếu việc này giúp ích cho bạn.

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

@Sandie Không có vấn đề gì - khi bạn vui, vấn đề của bạn đã được giải quyết, đừng quên đánh dấu câu trả lời đúng bằng cách đánh dấu bên trái câu trả lời đã giúp bạn :)
Jonno

Cảm ơn Jonno, điều này đã rất hữu ích. Mã của bạn hoạt động mặc dù tôi cần thêm hai tiêu chí bổ sung vào mã định danh. Chúng yêu cầu một phạm vi ô được chỉ định trước và sau một khối để trống trước khi xóa khối. If (i - startOfBlock) <= Cells (1, 15) .Value And Application.Sum (Range (Cells (i, iCol), Cells (i + Cells (1, 15) .Value, iCol))) = 0 Sau đó - Tiêu chí bổ sung này hoạt động nhưng thứ hai hiển thị bên dưới không như tôi nghĩ rằng nó đang cố gắng xem các hàng trước Row1? Và Application.Sum (Phạm vi (Các ô (i-startofBlock, iCol), Các ô (i-startofBlock - Các ô (1, 15) .Value, iCol))) = 0
Sandie

Vâng, nó sẽ tìm kiếm một hàng tiêu cực không thể thực hiện được. Bạn có thể thêm tiêu chí thứ hai trong tôi If (i - startOfBlock) < Cells(1, 15).Value Then, và làm điều gì đó như If i - startOfBlock - Cells(1, 15).Value > 0 Then dòng tiếp theo 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 xóa khối End If dòng tiếp theo End If
Jonno

Cảm ơn một lần nữa Jonno, đây không chỉ là một tìm kiếm Google cho câu trả lời, tôi đánh giá cao bạn dành thời gian cho việc này.
Sandie

@Sandie Không phải là vấn đề - Tôi không biết bạn đang cố gắng đạt được điều gì nhưng hy vọng nó sẽ thành công :)
Jonno
Khi sử dụng trang web của chúng tôi, bạn xác nhận rằng bạn đã đọc và hiểu Chính sách cookieChính sách bảo mật của chúng tôi.
Licensed under cc by-sa 3.0 with attribution required.