Question

我是VBA的初学者。

我有两个工作簿，一个包含Demand，另一个包含Storage（或Supply）。

需求工作簿按日期排序 - 从最早到最晚。

在存储工作簿中，我为每台机器提供了大量的工具。

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

以下是工作簿的示例：

需求：

存储

这是我开始的代码，但我被卡住了。如果有人可以告诉我有关如何继续的想法，或者帮助我编写代码，我会很高兴。

Aleris

Answer 1

开始很好：）

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 2

首先按日期对数据进行排序。然后运行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

试试这个。

为需求和存储数据创建命名范围。
循环存储单元格以匹配值和计数。（首先是For循环）
遍历需求单元格以匹配列，如果找到则匹配注意要删除的值的计数。如果这也是真的那么删除行else退出。（第二个循环）
alreadyDeleted变量会保留已删除的行数。

Answer 3

此应该与您自己的工作簿完全相同，因为除了Integer - ＆gt;之外，我的代码未被触及。 Long并评论不必要的行。（使用我的测试工作表可以正常工作。）

请注意，它仅使用一个循环！内部循环被替换为过滤和排序

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

<强>警告：

如果需求表 中的工具类型 ，并且存储表中包含工具的名称，则此一种循环技术仅有效

我还添加了一个整洁且完整记录的版本，因此您可以了解其工作原理：

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

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

3 个答案: