-3

在庫システムのダッシュボードを作成しようとしています。ダッシュボードには、その日の売上 (カテゴリ 1)、必要な購入 (カテゴリ 2)、予想される発注書 (カテゴリ 3)、仕掛品 (カテゴリ 4) が表示されます。この質問では、カテゴリ 2 の購入が必要な場合のみに焦点を当てます。

Worksheets("Purchasing") からダッシュボードのカテゴリ 2 にすべてのデータを転送しようとしています。項目が追加/削除されると各カテゴリの範囲が変動するため、名前付き範囲を使用してこれを実行しようとしています。私が取り組んでいるワークブックのサンプルは、ここ(excelforum.com) にあります。

以下のコードは、私がこれまでに持っているものです。ある程度は機能しますが、Cell $A$8 である Range("PurchaseStart") は 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
4

2 に答える 2

0

私はそれを考え出した。問題を処理するのはかなり良い方法だと思いますが、誰かがより良い方法を考えられるなら、それを聞いてみたいです. みんな助けてくれてありがとう。

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
于 2016-11-29T16:56:16.443 に答える