Excel宏，用于在框架不完整时清理数据（删除行）

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

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

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

我的数据如下所示：

13579，x1，y1，z1
23579，x2，y2，z2
73579，x7，y7，z7
83579，x8，y8，z8
13580，x1，y1，z1
23580，x2，y2，z2
73580x7，y7，z7
83580，x8，y8，z8
13581，x1，y1，z1
23581，x2，y2，z2
73581、x7、y7、z7
83581，x8，y8，z8
13582，x1，y1，z1
23582，x2，y2，z2
7、3582、x7、y7、z7
83582，x8，y8，z8
13583，x1，y1，z1
23583，x2，y2，z2
13584，x1，y1，z1
23584，x2，y2，z2
13585，x1，y1，z1
23585，x2，y2，z2
13586，x1，y1，z1
23586，x2，y2，z2
73586，x7，y7，z7
83586，x8，y8，z8

在上面的数据集中，我想删除不完整的3583、3584和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

在第一行创建一列“F”，其公式为

=COUNTIF（B:B，B1）

。双击“填充”按钮（单元格右下角）复制所有数据的公式

然后，在表中单击并执行

CTRL+A

，然后执行

CTRL+L

——当它询问您的数据是否有标题时，说“否”，它将添加列名。然后，按F列筛选任何小于4的传感器，并删除这些行。清除过滤器，你就可以走了

编辑在评论/讨论之后，这里是一个VBA代码，它可以完成您需要它做的事情（已测试）：

Public Sub-clean（）
作为整数的Dim i
i=1
做
将a变暗为整数
a=工作表函数.CountIf（范围（“B:B”），单元格（i，2））
如果（a<4）和Len（单元格（i，1））>0，则
第（i）行。删除
其他的
i=i+1
如果结束
当Len（单元（i，1））大于0时循环
端接头

您已经尝试了什么？首先，我要删除所有少于

SensorCount

条目的传感器。这不需要宏，只需要一些巧妙的公式和过滤。@rmayer06我试图包含我使用过的Matlab代码，但stackoverflow不接受格式，在使用control-K尝试了20次后，我放弃了包含它。我有数百个工作表要处理，所以我不想导入到Matlab，运行脚本并再次导出到excel。我对Matlab有点熟悉，但您在这里指出excel。是否有要在Excel中导入和处理的CSV文件列表？或者你更愿意用Matlab标签来问这个问题？哎呀！VBA代码似乎过于复杂。我将从头开始我的概念，然后请你解释为什么它不起作用，如果它不起作用。你没有将所有文件合并在一起进行处理有什么原因吗？我看不出如何在任何有意义的分析中有效地利用数百个数据文件。如果您需要一个宏来执行此操作（例如，许多文件），则相同的逻辑适用于宏，但将在宏中为每行计算

Countif

。我有数百个工作表要处理，这些都是从.csv文件导入的-这就是为什么我问有关宏的问题。我知道如何填写公式，但我正在寻找一个宏（一个键盘快捷键）来删除不完整的帧。就像我说的，将我写的代码工作到宏中。如果您自己开始使用宏，我会帮助您。您的vba代码工作正常！非常感谢。确实需要一段时间（每张工作表大约1-2分钟，每张工作表至少16000行），这是预期的吗？你帮我省了好几天坐在办公桌前重复废话的时间。非常感谢！是的，我从来没有在这里优化过速度。但它是有效的，只需要很少的努力，所以这就是最终完成的任务。

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`

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