根据另一个表的THREE列中的值删除一个表中的行

我有两个工作簿 – 需求和存储之一。 我的目的是根据存储工作簿中的数量，types和configuration从需求工作簿中删除一些工具。 删除的工具需要是截止date与当前date最接近的工具。

例如，如果存储工作簿中有2个Aleris 8500工具，则删除需求工作簿中前两个即将推出的Aleris 8500工具。 到现在为止，我完全是基于工具types。 现在我想添加第二个标准 – 工具的configuration。 我需要帮助，因为我是VBA的初学者。

要继续前面的示例，如果Aleris 8500的2个工具的configuration为150，则需要使用此configuration删除前2个即将推出的Aleris 8500工具。

需求工作簿看起来像这样：

存储工作簿看起来像这样：

这是我的代码，只是基于工具types删除：

Sub Demand_Minus_Storage() Dim QT As Long Dim i As Long 'open demand workbook Dim Demand_WB As Workbook Set Demand_WB = Workbooks.Open("C:\Users\rosipov\Desktop\eliran\MFG - GSS\Demand_Optics " & Format(Now(), "dd.mm.yyyy") & ".xlsx") 'open storage workbook Dim storage_wb As Workbook Set storage_wb = Workbooks.Open("C:\Users\rosipov\Desktop\eliran\MFG - GSS\OpticLabStorage.xlsm") 'now we romove from the demand what we already have in our storage 'Illuminators Dim rngRow As Range Demand_WB.Worksheets("Illuminators").Activate With storage_wb.Worksheets("Illuminator") For Each rngRow In .Range(.Rows(3), .Rows(WorksheetFunction.Match("*", .Range("A:A"), -1))).Rows With Worksheets("Illuminators").UsedRange.Offset(1) .Sort .Columns(5) .Offset(-1).AutoFilter Field:=5, Criteria1:="=" & rngRow.Cells(1) & "*" .Sort .Columns(2) With .SpecialCells(xlCellTypeVisible).EntireRow.Areas(1) Range(.Rows(1), .Rows(WorksheetFunction.Min(rngRow.Cells(3), .Rows.Count))).Delete End With .Offset(-1).AutoFilter .Sort .Columns(2) End With Next End With Cells(1).Select End Sub 

Answer 1

编辑： ^{_{（v0.1.1）错误修复，以避免数量为零时删除工具。}}

要添加第二个标准，您需要的只是一个额外的sorting和一个额外的自动filter。

以下是添加了修改的原始代码：

 Sub Demand_Minus_Storage() 'Dim QT As Long 'Dim i As Long 'open demand workbook Dim Demand_WB As Workbook Set Demand_WB = Workbooks.Open("C:\Users\rosipov\Desktop\eliran\MFG - GSS\Demand_Optics " & Format(Now(), "dd.mm.yyyy") & ".xlsx") 'open storage workbook Dim storage_wb As Workbook Set storage_wb = Workbooks.Open("C:\Users\rosipov\Desktop\eliran\MFG - GSS\OpticLabStorage.xlsm") 'now we romove from the demand what we already have in our storage 'Illuminators Dim rngRow As Range Demand_WB.Worksheets("Illuminators").Activate With storage_wb.Worksheets("Illuminator") For Each rngRow In .Range(.Rows(3), .Rows(WorksheetFunction.Match("*", .Range("A:A"), -1))).Rows If rngRow.Cells(3) > 0 Then With Demand_WB.Worksheets("Illuminators").UsedRange.Offset(1) .Sort .Columns(6) ' BBSE .Sort .Columns(5) ' Tool Type .Offset(-1).AutoFilter Field:=5, Criteria1:="=" & rngRow.Cells(1) .Offset(-1).AutoFilter Field:=6, Criteria1:="=" & rngRow.Cells(2) .Sort .Columns(2) ' Due Date With .SpecialCells(xlCellTypeVisible).EntireRow.Areas(1) Range(.Rows(1), .Rows(WorksheetFunction.Min(rngRow.Cells(3), .Rows.Count))).Delete End With .Offset(-1).AutoFilter .Sort .Columns(2) ' Due Date End With End If Next End With Cells(1).Select End Sub 

我还添加了一个整理完整的文档版本：

 Sub Demand_Minus_Storage() Const n_DemandHeaderRows As Long = 1 Const i_SN_UTID As Long = 1 Const i_Due_Date As Long = 2 Const i_Tool_Type As Long = 5 Const i_BBSE As Long = 6 Const n_StorageHeaderRows As Long = 2 Const i_OpticLab_Tool_Type As Long = 1 Const i_OpticLab_Configuration As Long = 2 Const i_OpticLab_QT As Long = 3 Dim ƒ As WorksheetFunction: Set ƒ = WorksheetFunction Dim storage_wb As Workbook Set storage_wb = Workbooks.Open("C:\Users\rosipov\Desktop\eliran\MFG - GSS\OpticLabStorage.xlsm") Dim Demand_WB As Workbook Set Demand_WB = Workbooks.Open("C:\Users\rosipov\Desktop\eliran\MFG - GSS\Demand_Optics " & Format(Now(), "dd.mm.yyyy") & ".xlsx") With storage_wb.Worksheets("Illuminator") ' Use the worksheet function "Match" to find the last storage used row ' Then loop through each storage row Dim rngRow As Range For Each rngRow In .Range(.Rows(n_StorageHeaderRows + 1), .Rows(ƒ.Match("*", .Columns(i_SN_UTID), -1))).Rows ' Only action tools with a quantity greater than zero If rngRow.Cells(i_OpticLab_QT) > 0 Then ' Skip the header rows and at the same time add at least one row after the end of the table With Demand_WB.Worksheets("Illuminators").UsedRange.Offset(n_DemandHeaderRows) ' Need to sort by BBSE and by tool type so the rows to be deleted are contiguous .Sort .Columns(i_BBSE) .Sort .Columns(i_Tool_Type) ' Back up to last header row and apply the filter ' Filter for the tool type that matches the tool type in the current storage row .Offset(-1).AutoFilter Field:=i_Tool_Type, Criteria1:="=" & rngRow.Cells(i_OpticLab_Tool_Type) ' Filter for the BBSE that matches the configuration in the current storage row .Offset(-1).AutoFilter Field:=i_BBSE, Criteria1:="=" & rngRow.Cells(i_OpticLab_Configuration) ' Need to re-sort by date as we previously sorted by tool type .Sort .Columns(i_Due_Date) ' Grab the first visible contiguous area. There is always at least the one from the row(s) after the end of the table. ' If there are any matching tools, these will form an area preceding the end of table area. With .SpecialCells(xlCellTypeVisible).EntireRow.Areas(1) ' Make sure we don't delete more rows than were actually found. ' If none were found, empty rows at the end of the table get deleted. Range(.Rows(1), .Rows(ƒ.Min(rngRow.Cells(i_OpticLab_QT), .Rows.Count))).Delete End With ' Turn autofilter off and show all hidden rows .Offset(-n_DemandHeaderRows).AutoFilter ' Need to re-sort by date as hidden rows were not sorted in previous date sort .Sort .Columns(i_Due_Date) End With End If Next End With ' Tidy up Cells(1).Select End Sub