Excel 需要查找合作行，如果不存在，则删除行

•从2开始读取行，并获取列d •检查该行的A列，如果是4610*则获取B列值 •现在读取a行，如果与上一列d的值相同，则检查a列的值 •如果新行列a等于480*或490*，请检查行列B的值 •如果新列B值=abs（旧列B值），则一切正常。保持那一排 •如果colmun d只有一个值4610*或480*或490*，且没有匹配的对应项，则将其删除

希望这样更好。基本上，我需要d列中的唯一编号来有两个条目 •a列中的一个值为4610*且为负值 •另一个a 480或490，b列中的值等于4610 abs值

基本上，它有点像支票簿，只是我处理了成百上千的交易，并在这些表格中发送。我甚至试着查找VBA来做一个支票簿，这就是我如何摆脱所有我绝对不需要的数据的方法。希望这更有意义。对于每4610，如果有匹配的480或490，我关心并需要保留两者，但如果只有一个或另一个，我不需要信息

所以在一些地方，有时是从490到490，它们共享一个doc num，但这两个对我来说并不重要，所以可以删除它们

我尝试使用VBA，我是一个noob，但我已经设法获取了一个非常大的数据集，并删除了所有我绝对不需要的行。现在，我试图找出vba代码，它将允许我完成删除其余未使用的数据。我正在做一个屏幕截图，但基本上在d列我有一个单据号。我需要查看所有行，如果a列是4610。*我需要在a列中有一个匹配的480*或490*相同单据号的值，b列4610*值必须是负数，480*和490*账户对应的单据号需要是=到abs这个负数

如果a列中的单据号为4610*，但a列中没有匹配的480*或490*号，则我需要删除该行。反之亦然，如果a列中有480*或490*而d列中没有相应的4610.*值，那么我需要删除它们。这是本垒打，我想不出任何有效的方法。我确实找到了一个很棒的方法来创建无限循环。我非常感谢任何帮助。多谢各位

我附上了迄今为止我制作的所有代码。我正试图把这个新的过程放在DataMatch子系统中。这是我第一次使用VBA，所以很有趣。再次感谢

Option Explicit

   Sub CleanUpData()
   'Prepare Excel for macro to run
     Application.Calculation = xlCalculationManual
   Application.EnableEvents = False
   Application.ScreenUpdating = False

    Call InitialDataClean
    Call SecondDataScrub
    Call DataMatch
    'Call RemoveBlanks

   'Return Excel to Status prior to Macro
   Application.Calculation = xlCalculationAutomatic
   Application.EnableEvents = True
   Application.ScreenUpdating = True
   End Sub
   Sub DataMatch()

   End Sub

   Sub RemoveBlanks()

    'Declare the variables
    Dim deleteRow As Long
    Dim ws As Worksheet


    'Set Objects & declare known variables
    Set ws = ActiveSheet
        'Loop through the rows of data, in order to delete row matching desired variables
        For deleteRow = ws.Range("A" & Rows.Count).End(xlUp).Row To 2 Step -1
        If ws.Range("A" & deleteRow).Text = "" Then
        Rows(deleteRow).EntireRow.ClearFormats
        Rows(deleteRow).EntireRow.Delete
        End If
        Next deleteRow


End Sub



Sub SecondDataScrub()


    'Declare the variables
    Dim deleteRow As Long
    Dim ws As Worksheet
    Dim myCriteria2 As String
    Dim myCriteria3 As String

    'Set Objects & declare known variables
    Set ws = ActiveSheet
    myCriteria2 = "*480*"
    myCriteria3 = "*490*"

        'Loop through the rows of data, in order to delete row matching desired variables
        For deleteRow = ws.Range("A" & Rows.Count).End(xlUp).Row To 2 Step -1

        'Initial removal of unneeded data
        If ws.Range("A" & deleteRow).Text Like myCriteria2 And ws.Range("b" & deleteRow).Value < 0 Then
        Rows(deleteRow).EntireRow.Delete
        End If
        If ws.Range("A" & deleteRow).Text Like myCriteria3 And ws.Range("b" & deleteRow).Value < 0 Then
        Rows(deleteRow).EntireRow.Delete
        End If

      Next deleteRow



End Sub


Sub InitialDataClean()


    'Declare the variables
    Dim deleteRow As Long
    Dim ws As Worksheet
    Dim myCriteria As String
    Dim myCriteria2 As String
    Dim myCriteria3 As String

    'Set Objects & declare known variables
    Set ws = ActiveSheet
    myCriteria = "*4610.*"
    myCriteria2 = "*4700.*"
    myCriteria3 = "*4871.*"

        'Loop through the rows of data, in order to delete row matching desired variables
        For deleteRow = ws.Range("A" & Rows.Count).End(xlUp).Row To 2 Step -1

        'Initial removal of unneeded data
        If ws.Range("A" & deleteRow).Text Like myCriteria And ws.Range("B" & deleteRow).Value >= 0 Then
        Rows(deleteRow).EntireRow.Delete
        End If
        'If ws.Range("A" & deleteRow).Text = "" Then
        'Rows(deleteRow).EntireRow.ClearFormats
        'Rows(deleteRow).EntireRow.Delete
        'End If
        If ws.Range("A" & deleteRow).Text Like myCriteria2 Then
        Rows(deleteRow).EntireRow.Delete
        End If
        If ws.Range("A" & deleteRow).Text Like myCriteria3 Then
        Rows(deleteRow).EntireRow.Delete
        End If

      Next deleteRow


End Sub


  [1]: https://i.stack.imgur.com/kgezp.png

选项显式
子目录a（）
'准备Excel以运行宏
Application.Calculation=xlCalculationManual
Application.EnableEvents=False
Application.ScreenUpdating=False
调用InitialDataClean
调用第二个数据库CRUB
呼叫数据匹配
“呼叫删除空格”
'将Excel返回到宏之前的状态
Application.Calculation=xlCalculationAutomatic
Application.EnableEvents=True
Application.ScreenUpdating=True
端接头
子数据匹配（）
端接头
子删除空白（）
'声明变量
将行变长
将ws设置为工作表
'设置对象并声明已知变量
设置ws=ActiveSheet
'循环遍历数据行，以删除与所需变量匹配的行
对于deleteRow=ws.Range（“A”&Rows.Count）.End（xlUp）.Row到2步骤-1
如果ws.Range（“A”&deleteRow）.Text=”“，则
行（deleteRow）.EntireRow.ClearFormats
行（deleteRow）.EntireRow.Delete
如果结束
下一行
端接头
次级CRUB（）
'声明变量
将行变长
将ws设置为工作表
将myCriteria2设置为字符串
将myCriteria3设置为字符串
'设置对象并声明已知变量
设置ws=ActiveSheet
myCriteria2=“*480*”
myCriteria3=“*490*”
'循环遍历数据行，以删除与所需变量匹配的行
对于deleteRow=ws.Range（“A”&Rows.Count）.End（xlUp）.Row到2步骤-1
'初始删除不需要的数据
如果ws.Range（“A”和deleteRow）.Text像myCriteria2和ws.Range（“b”和deleteRow）.Value<0，那么
行（deleteRow）.EntireRow.Delete
如果结束
如果ws.Range（“A”和deleteRow）.Text像myCriteria3和ws.Range（“b”和deleteRow）.Value<0，那么
行（deleteRow）.EntireRow.Delete
如果结束
下一行
端接头
子初始值dataclean（）
'声明变量
将行变长
将ws设置为工作表
将myCriteria设置为字符串
将myCriteria2设置为字符串
将myCriteria3设置为字符串
'设置对象并声明已知变量
设置ws=ActiveSheet
myCriteria=“*4610.*”
myCriteria2=“*4700.*”
myCriteria3=“*4871.*”
'循环遍历数据行，以删除与所需变量匹配的行
对于deleteRow=ws.Range（“A”&Rows.Count）.End（xlUp）.Row到2步骤-1
'初始删除不需要的数据
如果ws.Range（“A”和deleteRow）.Text类似于myCriteria和ws.Range（“B”和deleteRow）.Value>=0，则
行（deleteRow）.EntireRow.Delete
如果结束
'如果ws.Range（“A”&deleteRow）.Text=”“，则
'行（deleteRow）.EntireRow.ClearFormats
'行（deleteRow）.EntireRow.Delete
"完"
如果ws.Range（“A”&deleteRow）.Text类似于myCriteria2，那么
行（deleteRow）.EntireRow.Delete
如果结束
如果ws.Range（“A”&deleteRow）.Text像myCriteria3那么
行（deleteRow）.EntireRow.Delete
如果结束
下一行
端接头
[1]: https://i.stack.imgur.com/kgezp.png

如果我没有弄错你的帖子，你的逻辑是：

• 读博士。D列中的编号（按行）
• 如果医生。否为空删除整行（删除E列中只有单据号的所有行）
• 检查A列前3位数字是否正确