Excel 宏，用于在帧不完整时清理数据(删除行)

Question

我有一个电子表格，其中包含来自 4 个传感器的数据，需要清理。有很多帧的传感器掉落，我需要删除不完整的帧集（换句话说，删除那些没有所有 4 个传感器数据的帧）。

列 A 是传感器#
B 列是帧 #（帧计数从不从 1 开始）。
C 列是 x
D 列为 y
列 E 是 z

对于完整的帧，B 列将在 4 个连续行中具有相同的帧#。我想删除不完整框架中的每一行。

我的数据如下所示：

1， 3579， x1， y1， z1
2， 3579， x2， y2， z2
7， 3579， x7， y7， z7
8， 3579， x8， y8， z8
1， 3580， x1， y1， z1
2， 3580， x2， y2， z2
7， 3580， x7， y7， z7
8， 3580， x8， y8， z8
1， 3581， x1， y1， z1
2， 3581， x2， y2， z2
7， 3581， x7， y7， z7
8， 3581， x8， y8， z8
1， 3582， x1， y1， z1
2， 3582， x2， y2， z2
7， 3582， x7， y7， z7
8， 3582， x8， y8， z8
1， 3583， x1， y1， z1
2， 3583， x2， y2， z2
1， 3584， x1， y1， z1
2， 3584， x2， y2， z2
1， 3585， x1， y1， z1
2， 3585， x2， y2， z2
1， 3586， x1， y1， z1
2， 3586， x2， y2， z2
7， 3586， x7， y7， z7
8， 3586， x8， y8， z8

在上面的数据集中，我想删除不完整帧 3583、3584 和 3585 的粗体行。

任何人都可以帮忙做宏吗？我有数百个工作表要处理，因此公式，填充，过滤和复制/粘贴将需要数天时间。非常感谢您能提供的任何帮助！

我在具有 8 个传感器的早期数据集上尝试了此代码（它使用 sensor# 而不是帧 #），但它不起作用。

sub clean_data()
'determine the number of rows
numrows = 1
Do While ActiveSheet.Cells(numrows, 1).Value > 0
    numrows = numrows + 1
Loop
numrows = numrows - 1
ActiveSheet.Cells(1, 14).Value = "Original"
ActiveSheet.Cells(1, 15).Value = "Cleaned"
ActiveSheet.Cells(2, 13).Value = "Row Count:"
ActiveSheet.Cells(2, 14).Value = numrows
'determine the number of frames, the number of entire frames missing, and which entire frames are missing
numframes = 0
numframes = ActiveSheet.Cells(numrows, 4).Value - ActiveSheet.Cells(1, 4).Value + 1
j = 4
missingframes = 0
numsensor1 = 0
numsensor2 = 0
numsensor3 = 0
numsensor4 = 0
numsensor5 = 0
numsensor6 = 0
numsensor7 = 0
numsensor8 = 0
For i = 1 To numrows
    If ActiveSheet.Cells(i + 1, 4).Value - ActiveSheet.Cells(i, 4).Value > 1 Then
        missingframes = missingframes + (ActiveSheet.Cells(i + 1, 4).Value - ActiveSheet.Cells(i, 4).Value) - 1
        'activesheet.Cells(j, 2).Value = activesheet.Cells(i, 4).Value
        'activesheet.Cells(j, 3).Value = (activesheet.Cells(i + 1, 4).Value - activesheet.Cells(i, 4).Value) - 1
        'j = j + 1
    End If
    If ActiveSheet.Cells(i, 1).Value = 1 Then
        numsensor1 = numsensor1 + 1
    ElseIf ActiveSheet.Cells(i, 1).Value = 2 Then
        numsensor2 = numsensor2 + 1
    ElseIf ActiveSheet.Cells(i, 1).Value = 3 Then
        numsensor3 = numsensor3 + 1
    ElseIf ActiveSheet.Cells(i, 1).Value = 4 Then
        numsensor4 = numsensor4 + 1
    ElseIf ActiveSheet.Cells(i, 1).Value = 5 Then
        numsensor5 = numsensor5 + 1
    ElseIf ActiveSheet.Cells(i, 1).Value = 6 Then
        numsensor6 = numsensor6 + 1
    ElseIf ActiveSheet.Cells(i, 1).Value = 7 Then
        numsensor7 = numsensor7 + 1
    ElseIf ActiveSheet.Cells(i, 1).Value = 8 Then
        numsensor8 = numsensor8 + 1
    End If
Next i
'activesheet.Cells(1, 3).Value = j
ActiveSheet.Cells(3, 13).Value = "Frame Count:"
ActiveSheet.Cells(3, 14).Value = numframes
ActiveSheet.Cells(4, 13).Value = "Missing Frames:"
ActiveSheet.Cells(4, 14).Value = missingframes
ActiveSheet.Cells(5, 13).Value = "Sensor 1:"
ActiveSheet.Cells(5, 14).Value = numsensor1
ActiveSheet.Cells(6, 13).Value = "Sensor 2:"
ActiveSheet.Cells(6, 14).Value = numsensor2
ActiveSheet.Cells(7, 13).Value = "Sensor 3:"
ActiveSheet.Cells(7, 14).Value = numsensor3
ActiveSheet.Cells(8, 13).Value = "Sensor 4:"
ActiveSheet.Cells(8, 14).Value = numsensor4
ActiveSheet.Cells(9, 13).Value = "Sensor 5:"
ActiveSheet.Cells(9, 14).Value = numsensor5
ActiveSheet.Cells(10, 13).Value = "Sensor 6:"
ActiveSheet.Cells(10, 14).Value = numsensor6
ActiveSheet.Cells(11, 13).Value = "Sensor 7:"
ActiveSheet.Cells(11, 14).Value = numsensor7
ActiveSheet.Cells(12, 13).Value = "Sensor 8:"
ActiveSheet.Cells(12, 14).Value = numsensor8
'practice code for insertion and copy/paste
'activesheet.Cells(10, 1).Offset(1).EntireRow.Insert shift:=xlDown 'practice row insert
'activesheet.Rows(3).Select
'Selection.Copy
'activesheet.Rows(11).Activate
'activesheet.Paste
'find first complete set of sensor data
j = 0
i = 0
Do While i <> numrows
    j = j + 1
    i = i + 1
    If j = 8 And ActiveSheet.Cells(i, 1).Value = 8 Then
        ActiveSheet.Cells(13, 13).Value = "First Set"
        first_set = i - 7
        ActiveSheet.Cells(13, 14).Value = first_set
        i = numrows
    ElseIf j <> 8 And ActiveSheet.Cells(i, 1).Value = 8 Then
        j = 0
    End If
Loop
'find missing sensors and fill in with data from previous sensor frame
j = 1
i = first_set + 8
k = 0
Do While k = 0
     'check for sensors 1 - 8 in sequence
    If ActiveSheet.Cells(i, 1).Value = j Then
                ActiveSheet.Cells(i, 12).Value = 0
        j = j + 1
    ElseIf ActiveSheet.Cells(i, 1).Value <> j Then
        ActiveSheet.Cells(i - 1, 1).Offset(1).EntireRow.Insert shift:=xlDown 'insert a row to accept copied data
        ActiveSheet.Rows(i - 8).Select 'select previous frame with data for missing sensor and then copy the data
        Selection.Copy
        ActiveSheet.Rows(i).Activate     'change focus to inserted row and paste in the missing data
        ActiveSheet.Paste
        ActiveSheet.Cells(i, 4).Value = ActiveSheet.Cells(i - 8, 4) + 1
        ActiveSheet.Cells(i, 12).Value = 1
        numrows = numrows + 1
        j = j + 1
    End If
    If j = 9 Then
        j = 1
    End If
    If i = numrows Then
        k = 1
    Else
        i = i + 1
    End If
Loop
'View cleaned data
missingframes = 0
numsensor1 = 0
numsensor2 = 0
numsensor3 = 0
numsensor4 = 0
numsensor5 = 0
numsensor6 = 0
numsensor7 = 0
numsensor8 = 0
i = 1
l = 0
Do While l = 0
    If ActiveSheet.Cells(i + 1, 4).Value - ActiveSheet.Cells(i, 4).Value > 1 Then
        k = 1
        j = 0
        Do While j = 0
            ActiveSheet.Cells((i + k - 1), 1).Offset(1).EntireRow.Insert shift:=xlDown 'insert a row to accept copied data
            ActiveSheet.Rows((i + k - 1) - 7).Select 'select previous frame with data for missing sensor and then copy the data
            Selection.Copy
            ActiveSheet.Rows(i + k).Activate 'change focus to inserted row and paste in the missing data
            ActiveSheet.Paste
            ActiveSheet.Cells(i + k, 4).Value = ActiveSheet.Cells(i, 4).Value + 1
            ActiveSheet.Cells(i + k, 12).Value = 2
            numrows = numrows + 1
            k = k + 1
            If k = 9 Then
                j = 1
            End If
        Loop
    End If
    i = i + 1
    If i = numrows + 1 Then
        l = 1
    End If
Loop

'determine the number of rows
numrows = 1
Do While ActiveSheet.Cells(numrows, 1).Value > 0
    numrows = numrows + 1
Loop
numrows = numrows - 1
'activesheet.Cells(1, 14).Value = "Original"
'activesheet.Cells(1, 15).Value = "Cleaned"
ActiveSheet.Cells(2, 13).Value = "Row Count:"
ActiveSheet.Cells(2, 15).Value = numrows
'determine the number of frames, the number of entire frames missing, and which entire frames are missing
numframes = 0
numframes = ActiveSheet.Cells(numrows, 4).Value - ActiveSheet.Cells(1, 4).Value + 1
For i = 1 To numrows
    If ActiveSheet.Cells(i + 1, 4).Value - ActiveSheet.Cells(i, 4).Value > 1 Then
        missingframes = missingframes + (ActiveSheet.Cells(i + 1, 4).Value - ActiveSheet.Cells(i, 4).Value) - 1
   End If
Next i
For i = 1 To numrows
    If ActiveSheet.Cells(i, 1).Value = 1 Then
        numsensor1 = numsensor1 + 1
    ElseIf ActiveSheet.Cells(i, 1).Value = 2 Then
        numsensor2 = numsensor2 + 1
    ElseIf ActiveSheet.Cells(i, 1).Value = 3 Then
        numsensor3 = numsensor3 + 1
    ElseIf ActiveSheet.Cells(i, 1).Value = 4 Then
        numsensor4 = numsensor4 + 1
    ElseIf ActiveSheet.Cells(i, 1).Value = 5 Then
        numsensor5 = numsensor5 + 1
    ElseIf ActiveSheet.Cells(i, 1).Value = 6 Then
        numsensor6 = numsensor6 + 1
    ElseIf ActiveSheet.Cells(i, 1).Value = 7 Then
        numsensor7 = numsensor7 + 1
    ElseIf ActiveSheet.Cells(i, 1).Value = 8 Then
        numsensor8 = numsensor8 + 1
    End If
Next i
'activesheet.Cells(1, 3).Value = j
'activesheet.Cells(3, 13).Value = "Frame Count:"
ActiveSheet.Cells(3, 15).Value = numframes
'activesheet.Cells(4, 13).Value = "Missing Frames:"
ActiveSheet.Cells(4, 15).Value = missingframes
'activesheet.Cells(5, 13).Value = "Sensor 1:"
ActiveSheet.Cells(5, 15).Value = numsensor1
'activesheet.Cells(6, 13).Value = "Sensor 2:"
ActiveSheet.Cells(6, 15).Value = numsensor2
'activesheet.Cells(7, 13).Value = "Sensor 3:"
ActiveSheet.Cells(7, 15).Value = numsensor3
'activesheet.Cells(8, 13).Value = "Sensor 4:"
ActiveSheet.Cells(8, 15).Value = numsensor4
'activesheet.Cells(9, 13).Value = "Sensor 5:"
ActiveSheet.Cells(9, 15).Value = numsensor5
'activesheet.Cells(10, 13).Value = "Sensor 6:"
ActiveSheet.Cells(10, 15).Value = numsensor6
'activesheet.Cells(11, 13).Value = "Sensor 7:"
ActiveSheet.Cells(11, 15).Value = numsensor7
'activesheet.Cells(12, 13).Value = "Sensor 8:"
ActiveSheet.Cells(12, 15).Value = numsensor8
End Sub

我有数百个文件，所以我不想导入到 Matlab，运行脚本然后导出回 excel。但这里是概念上有效的 Matlab 代码（第 4 列包含此数据集中的 frame#）：

i=xlsread('33_F_.xlsm');
`i2=[i(:,1) i(:,4) i(:,6:11)];  
i3=[];  
[m,n]= size(i2);  
count=1;  
frame=i2(1,2);  
for j=2:m  
if(count==1)  
    frame=i2(j,2);  
end  
if(i2(j,2)==frame)  
    count=count+1;  
else  
    frame=i2(j,2);  
    count=1;  
    i2(j-count:j-1)=[];  
end  
if(count==4)  
    count=0;  
    i3=[i3;i2(j-3:j,:)];  
end  
end`

Answer 1

创建一个列"F"，公式=COUNTIF(B:B,B1)在第一行。双击向下填充按钮（单元格的右下角）以复制所有数据的公式。

然后，在表中单击并执行CTRL+A后跟CTRL+L - 当它询问您的数据是否有标题时，说"否"，它将添加列名。 然后，按列 F 筛选任何小于 4 的传感器，并删除这些行。 清除过滤器，您就可以开始了。

编辑以下评论/讨论，这是一个VBA代码，可以执行您需要它执行的操作（经过测试）：

Public Sub clean()    
Dim i As Integer
i = 1    
Do    
    Dim a As Integer
    a = WorksheetFunction.CountIf(Range("B:B"), Cells(i, 2))
    If (a < 4) And Len(Cells(i, 1)) > 0 Then
       Rows(i).Delete
    Else
       i = i + 1
    End If        
Loop While Len(Cells(i, 1)) > 0    
End Sub