根据另一个表中的内容删除一个表中的顶部行

我是VBA的初学者。

我有两个工作簿，一个包含需求和其他存储（或供应）。

需求工作簿按datesorting – 从最早到最晚。

在存储工作簿中，我有每台机器的每个工具的数量。

我想创build一个子例程，删除存储工作簿中每个工具的需求工作簿中最早的第一行。 例如，如果在存储中有3个Aleristypes的工具，我想删除包含Aleris的最早的3行。

以下是工作簿的示例：

需求：

存储：

这是我开始的代码，但我卡住了。 如果有人可以告诉我如何进行的想法，或帮我代码，我会很高兴。

 Option Explicit Sub Demand_Minus_Storage() Dim QT As Integer Dim i As Integer 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") Dim storage_wb As Workbook Set storage_wb = Workbooks.Open("C:\Users\rosipov\Desktop\eliran\MFG - GSS\OpticLabStorage.xlsm") storage_wb.Worksheets("Illuminator").Range("C3").Activate Set QT = ActiveCell.Value Demand_WB.Worksheets("Illuminators").Activate End Sub 

Answer 1

这应该与您自己的工作簿完全一样，因为除了Integer – > Long Integer以外，我还保留了代码，并注释掉不必要的行。 （使用我的testing工作表，它工作正常。）

请注意，它只使用一个循环！ 内部循环被replace为过滤和sorting

 Sub Demand_Minus_Storage() 'Dim QT As Long 'Dim i As Long 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") Dim storage_wb As Workbook Set storage_wb = Workbooks.Open("C:\Users\rosipov\Desktop\eliran\MFG - GSS\OpticLabStorage.xlsm") 'storage_wb.Worksheets("Illuminator").Range("C3").Activate 'QT = ActiveCell.Value Demand_WB.Worksheets("Illuminators").Activate Dim rngRow As Range With storage_wb.Worksheets("Illuminator") For Each rngRow In .Range(.Rows(3), .Rows(WorksheetFunction.Match("*", .Range("A:A"), -1))).Rows With Demand_WB.Worksheets("Illuminators").UsedRange.Offset(1) .Sort .Columns(5) ' Tool Type .Offset(-1).AutoFilter Field:=5, Criteria1:="=" & rngRow.Cells(1) & "*" .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 Next End With Cells(1).Select End Sub 

警告：

这种循环技术只有在需求表中的工具types以存储表中的工具名称开始 时才起作用。

---

我还添加了一个整理完整的文档版本，所以你可以理解它是如何工作的：

 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 n_StorageHeaderRows As Long = 2 Const i_Tool As Long = 1 Const i_QT As Long = 3 Dim rngRow As Range 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 For Each rngRow In .Range(.Rows(n_StorageHeaderRows + 1), .Rows(ƒ.Match("*", .Columns(i_SN_UTID), -1))).Rows ' 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 tool type so the rows to be deleted are contiguous .Sort .Columns(i_Tool_Type) ' Back up to last header row and apply the filter ' The filter is for any tool type that starts with the tool in the current storage row .Offset(-1).AutoFilter Field:=i_Tool_Type, Criteria1:="=" & rngRow.Cells(i_Tool) & "*" ' 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 tool tips, 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_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 Next End With ' Tidy up Cells(1).Select End Sub 

Answer 2

开始是非常好的:)

 Option Explicit Sub Demand_Minus_Storage() Dim QT As Long Dim i As Long Dim j As Long Dim lastRow As Long Dim lastRowDemands As Long Dim toolName As String 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") Dim storage_wb As Workbook Set storage_wb = Workbooks.Open("C:\Users\rosipov\Desktop\eliran\MFG - GSS\OpticLabStorage.xlsm") 'in storage workbook, determine how many rows we have 'I assume that sheets in workbooks you mentioned are first ones! 'generally, use storage_wb.Worksheets("name of the sheet")... lastRow = storage_wb.Worksheets(1).Cells(2, 1).End(xlDown).Row 'get also last row of table in demands_wb lastRowDemands = demands_wb.Worksheets(1).Cells(2, 1).End(xlDown).Row For i = 3 To lastRow QT = storage_wb.Worksheets(1).Cells(i, 3).Value 'get QT of tool toolName = LCase(storage_wb.Worksheets(1).Cells(i, 1).Value) 'get name of tool, all characters are lowered, in order to better comparison 'loop through demands table For j = 1 To lastRowDemands 'if tool name is found in E column, delete that row If InStr(1, LCase(demands_wb.Worksheets(1).Cells(5, j).Value), toolName) > 0 Then demands_wb.Worksheets(1).Rows(j).Delete 'we have to subtract one from j, so we don't omit any row j = j - 1 'we also have one row less to check lastRowDemands = lastRowDemands - 1 QT = QT - 1 End If If QT = 0 Then 'if we deleted the desired amount, then exit loop Exit For End If Next j Next i End Sub 

Answer 3

首先按date对数据进行sorting。 然后运行一个For循环，并检查QT值。

 Public Sub DeleteFromDemand() Dim storageRng As Range Dim demandRng As Range Dim loopCellStorage As Range Dim loopcell As Range Dim cntToDelete As Integer Dim alreadyDeleted As Integer 'comment make a storage range name. Set demandRng = Range("DemandRng") Set storageRng = Range("StorageRng") For Each loopCellStorage In storageRng.Columns(1).Rows.Cells For Each loopcell In demandRng.Columns(5).Rows.Cells If loopcell.Value Like "*" & loopCellStorage.Value2 & "*" Then If alreadyDeleted <= loopCellStorage.Columns(3).Value2 Then alreadyDeleted = alreadyDeleted + 1 loopcell.EntireRow.Delete xlShiftUp Else Exit For End If End If Next loopcell Next End Sub 

尝试这个。

1. 为需求和存储数据创build命名范围。
2. 循环访问存储单元以匹配值和计数。 （第一个For循环）
3. 循环遍历需求单元格以匹配列，如果find，则记下要删除的值的计数。如果这也是真的，则删除行else退出。 （第二个循环）
4. alreadyDeletedvariables保持被删除的行数。