VBA：使用“移动范围”将数据从一个工作表传输到另一个工作表

Question

我正在尝试创建我的库存系统的仪表板。仪表板将显示当天的销售额（类别 1）、需要进行的采购（类别 2）、预期的采购订单（类别 3）和在制品（类别 4）。对于这个问题，我只关注类别 2，需要进行的购买。

我正在尝试将所有数据从 Worksheets("Purchasing") 传输到类别 2 下的仪表板。我正在尝试使用命名范围来执行此操作，因为每个类别的范围会随着项目的添加而波动/删除。您可以在 excelforum.com 上找到我正在编写的工作簿样本 here。

下面的代码是我目前所拥有的。它在一定程度上起作用，但范围（“PurchaseStart”），即 Cell $A$8，从 A:1 开始。我不知道如何只选择我正在寻找的命名范围。我在每一行的末尾添加了“结束#”语句来表示一个截止值，并希望诱使 excel 只选择特定类别的范围。

Option Explicit

Sub purchPull()

Dim Dashboard As Worksheet
Dim Purchasing As Worksheet
Dim PM As Range, D As Range, Rng As Range
Dim purchName As Range

Set Purchasing = Worksheets("Purchasing")
Set Dashboard = Worksheets("Dashboard")


' Go through each Item in Purchasing and check to see if it's anywhere      within the named range "PurchaseStart"
' In this case it should be "A8:A9" - as there is nothing in the dasboard yet
For Each PM In Purchasing.Range(Purchasing.Cells(1, 1),     Purchasing.Cells(Purchasing.Rows.Count, 1).End(xlUp))
    With Dashboard.Range("PurchaseStart",   Dashboard.Cells(Dashboard.Rows.Count, 1))
    Set Rng = .Find(What:=PM.Offset(0, 1), _
        After:=.Cells(.Cells.Count), _
        LookIn:=xlValues, _
        LookAt:=xlWhole, _
        SearchOrder:=xlByRows, _
        SearchDirection:=xlNext, _
        MatchCase:=False)
    If Not Rng Is Nothing Then
        ' Do nothing, as we don't want duplicates
    Else
        ' From the start of the named range, transfer data over - THIS IS THE PROBLEM AREA
        With Dashboard.Range("PurchaseStart", Dashboard.Cells(.Rows.Count, 1)).End(xlUp)
            .Offset(1, 1) = PM.Offset(0, 0) ' Order Number
            .Offset(1, 2) = PM.Offset(0, 1) ' SKU
            .Offset(1, 3) = PM.Offset(0, 3) ' Qty
            .Offset(1, 4) = PM.Offset(0, 4) ' Date
        End With
    End If
End With
Next

End Sub

Answer 1

您可以执行以下操作： （这假设每个数据部分的开头都有一些标题，即“需要制作”，然后在该标题下方是该部分的数据所在的位置）：

Sub findDataStartRow()
Dim f as Range, dataStartRange as Range

Set f = Columns(1).Find(what:="Need to be made", lookat:xlWhole)
If Not f is Nothing Then
    dataStartRange = Cells(f.row + 1, 1) 'Do stuff with this range... maybe insert rows below it to start data
Else: Msgbox("Not found")
    Exit Sub
End if
End Sub

对每个部分执行类似操作。这样，无论标题在哪里（以及因此应该放置数据的开始位置），您将始终在标题正下方有一个命名的位置范围。 或者，如果您想将数据添加到该部分的末尾，只需在下面找到您想要数据的部分的标题，并在正确修改.Find后设置dataStartRange = Cells(f.row - 1, 1)。

Answer 2

我想通了。我认为这是处理问题的一种很好的方法，但是如果有人能想到更好的方法，我很想听听。感谢大家的帮助。

Option Explicit

Sub purchPull()

Dim Dashboard As Worksheet
Dim Purchasing As Worksheet
Dim PM As Range, D As Range, Rng As Range
Dim purchName As Range
Dim lastRow As Long
Dim firstRow As Long

Set Purchasing = Worksheets("Purchasing")
Set Dashboard = Worksheets("Dashboard")

' first row of named range "PurchaseStart"
firstRow = Dashboard.Range("PurchaseStart").Row +     Dashboard.Range("PurchaseStart").Rows.Count



' Go through each Item in Purchasing and check to see if it's anywhere within the named range "PurchaseStart"
With Purchasing
For Each PM In Purchasing.Range(Purchasing.Cells(2, 1), Purchasing.Cells(Purchasing.Rows.Count, 1).End(xlUp))
    With Dashboard.Range("PurchaseStart", Dashboard.Cells(Dashboard.Rows.Count, 1))
        Set Rng = .Find(What:=PM.Offset(0, 0), _
            After:=.Cells(.Cells.Count), _
            LookIn:=xlValues, _
            LookAt:=xlWhole, _
            SearchOrder:=xlByRows, _
            SearchDirection:=xlNext, _
            MatchCase:=False)
        If Not Rng Is Nothing Then
            ' Do nothing, as we don't want duplicates
        Else      
            ' Identify the last row within the named range "PurchaseStart"
            lastRow = Dashboard.Range("PurchaseStart").Cells(1, 1).End(xlDown).Row
            ' Transfer the data over
            With Dashboard.Cells(lastRow, 1).End(xlUp)
                .Offset(1, 0).EntireRow.Insert
                .Offset(1, 0) = PM.Offset(0, 0)  ' Order Number
                .Offset(1, 1) = PM.Offset(0, 1) ' SKU
                .Offset(1, 2) = PM.Offset(0, 2) ' Qty
                .Offset(1, 3) = PM.Offset(0, 3) ' Date
            End With
        End If
    End With
Next
End With

End Sub