当宏不完整时，Excel宏可以清理数据（删除行）

Question

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

A列是传感器＃
B列是框架＃（framecount永远不会从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＆amp;的粗体行。 3585。

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

我在早期的数据集上尝试了这个代码，这个数据集有8个传感器（它使用传感器＃而不是框架＃），但它不起作用。

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列包含此数据集中的框架＃）：

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

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

然后，在表格中点击并执行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