Question

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

我正在尝试将所有数据从工作表（“采购”）传输到类别2下的仪表板。我正在尝试使用命名范围来执行此操作，因为每个类别的范围将随着项目的添加而波动/删除。您可以在here找到我正在处理的工作簿示例 - 它位于excelforum.com上。

以下代码是我目前所拥有的。它在某种程度上有效，但Range（“PurchaseStart”），即Cell $ A $ 8，从A：1开始。我不知道如何只选择我正在寻找的命名范围。我在每行的末尾添加了“End＃”语句来表示截止，并希望将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

您可以采取以下措施：（这假设每个数据部分的开头都有一些标题，即＆＃34;需要制作＆＃34;然后在该标题下面是该部分的数据所在的位置）：

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

每个部分都做类似的事情。这样，无论标题位于何处（因此数据应放置的位置），您始终在标题下方的位置具有命名范围。或者，如果您要将数据添加到该部分的末尾，只需找到您希望数据所在的部分的标题，并在正确修改dataStartRange = Cells(f.row - 1, 1)后设置.Find。 / p>

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

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

2 个答案: