bugfix> excel > 投稿

「データ」シートで確認できるように、このようなデータテーブルがあります(Plsは以下を参照)

私がなりたい出力はこのようなものです:

現在、出力シートで、

  1. 毎月手動でYYYYMMを各列に追加する必要があります
  2. 列の各月について、注文数量を取得するための数式を入力する必要があります。 式は次のとおりです。

    =IFNA(INDEX(Data!C:C,(MATCH(A3&$B$2,Data!D:D,0))),"")
    
    

このコードは、毎月の注文数量を提供します。

しかし、私がしたかったのは、毎月生成し、次を使用して注文数量を取得することですVBA

回答 2 件
  • バリアント配列を使用して結果を収集するサンプルは次のとおりですので、高速になります。

    結果テーブルのアイテムと番号のヘッダーが事前に構築されていると仮定します

    Sub Demo()
        'Call FillTable with parameters
        ' Top Left Cell of Source Data range, including headers
        ' Top Left Cell of Destination Table range, including headers
        ' Column to match in Source
        ' Column to return from Source
        FillTable Worksheets("Data").Range("A1"), Worksheets("Final").Range("A2"), 4, 3
    End Sub
    Sub FillTable(rSrc As Range, rTable As Range, MatchCol As Long, QtyCol As Long)
        Dim vSrc As Variant, vTable As Variant
        Dim Items As Variant, Dates As Variant
        Dim rw As Long, cl As Long
    
        Set rSrc = Range(rSrc.Offset(1, 0), rSrc.End(xlDown)).Resize(, Application.Max(MatchCol, QtyCol))
        Set rTable = Range(rTable.End(xlToRight).Offset(1, 0), rTable.End(xlDown).Offset(0, 1))
        vSrc = rSrc.Value2
        vTable = rTable.Value2
        Items = rTable.Columns(0).Value2
        Dates = rTable.Rows(0).Value2
        For cl = 1 To UBound(vTable, 2)
        For rw = 1 To UBound(vTable, 1)
            With Application
                vTable(rw, cl) = .IfNa(.Index(rSrc.Columns(QtyCol), .Match(Items(rw, 1) & Dates(1, cl), rSrc.Columns(MatchCol), 0)), vbNullString)
            End With
        Next rw, cl
        rTable = vTable
    End Sub
    
    

  • Sub FillData()
    For Each cell In Worksheets("Data").Columns(2).Cells
        If cell.Value = "" Then Exit Sub    'stop program if no value
        If WorksheetFunction.IsText(cell.Value) = True Then GoTo line1  'do not perform action if YYYYMM
        Set FindMth = Worksheets("Final").Rows(2).Find(cell.Value)  'Find Month at Final Sheet
        Set FindItem = Worksheets("Final").Columns(1).Find(cell.Offset(0, -1).Value, lookat:=xlWhole)   'Find Item Number at Final Sheet
        If Not FindMth Is Nothing Then
            C = FindMth.Column  'Column Month
        Else        
            If Worksheets("Final").Range("B2").Value <> "" Then
                Worksheets("Final").Range("A2").End(xlToRight).Offset(0, 1).Value = cell.Value
                C = Worksheets("Final").Range("A2").End(xlToRight).Column   'Column Month if B2 not empty
            Else
                Worksheets("Final").Range("B2").Value = cell.Value
                C = 2
            End If
        End If
        If Not FindItem Is Nothing Then
            R = FindItem.Row    'Row Item Number
        Else
            Worksheets("Final").Range("A1").End(xlDown).Offset(1).Value = cell.Offset(0, -1).Value
            R = Worksheets("Final").Range("A1").End(xlDown).Row
        End If
        Worksheets("Final").Cells(R, C).Value = cell.Offset(0, 1).Value 'Assign Order Qty
        Worksheets("Final").Range("B1:" & Cells(1, C).Address).Merge    'Merge YYYYMM cell
    line1:
    Next
    End Sub
    
    

あなたの答え