將定義范圍內的每個單元格向下粘貼 X 次，X 是另一個定義的單元格范圍的長度

Question

我有一個矩陣表：列 = 產品類型，行 = 每月單位數據

我正在編寫 VBA 代碼，它將使矩陣符合普通表

到目前為止，我有這個來填充產品類型的次數有幾個月。

Sub Create_Data_Table()

Dim RowCount As Long
Dim iRange As Range
Dim x As Integer
Dim y As Integer
Dim xy As Integer

Application.ScreenUpdating = False
        
Sheets(1).Activate

x = Range("Products").Count
y = Range("MonthYear").Count

Range("Products").Copy
Sheets(2).Activate

Do While y > 0

    Range("E2").Select
    For Each iRange In Rows
        If Application.CountA(iRange) > 0 Then
            RowCount = RowCount + 1
        End If
    Next

    Range("Products").Copy
    Range("E" & RowCount + 1).Select
    Selection.PasteSpecial xlPasteValues
    
    y = y - 1
    RowCount = 0
Loop

我很難想出一種方法來粘貼 MonthYear 范圍中的第一個月作為 Products 范圍的長度，然后在 MonthYear 范圍中的第二個單元格（月份）中重復。

有什么更有效的方法來解決這個問題嗎？

添加了所需輸出的圖片。

Answer 1

我會為此使用公式：

根據產品數量填寫日期的公式：

=OFFSET($B$1,0,ROUNDDOWN((ROW()-1)/COUNTA($A:$A),0))

每個月填充產品的公式：

=OFFSET($A$2,MOD(ROW()-2,COUNTA($A:$A)-1),0)

Answer 2

感謝您提供配方解決方案 Cameron。 我可能會測試一下，看看它是否比我寫的更好。 我正在為幾十個這樣的收入模板運行這個宏，所以最終我認為宏會很有用。 對於其他偶然發現這篇文章的人，我寫的解決方案是這樣的：

Sub Create_Data_Table()

Dim my1 As Long
Dim my2 As Long
Dim x As Long
Dim y As Long
Dim i As Long


Application.ScreenUpdating = False

x = Range("Unit_FamSubDiv").count
y = Range("Unit_MonthYear").count
my1 = 1
my2 = x + 1
i = 1

Sheets(2).Activate

Do While y > 0

    Range("Unit_FamSubDiv").Copy
    ActiveSheet.Cells(ActiveSheet.Rows.count, 5).End(xlUp).Offset(1).Activate
    Selection.PasteSpecial xlPasteValues
    Range("B" & 1 + my1 & ":B" & my2).Value = Range("Unit_MonthYear").Cells(i)

    y = y - 1
    my1 = my2
    my2 = my1 + x
    i = i + 1

Loop

Range("A2").Select
ActiveCell.FormulaR1C1 = _
    "=""Q""&ROUNDUP(MONTH(RC[1])/3,0)&""-""&RIGHT(YEAR(RC[1]),2)"
Range("A2").AutoFill Range("A2:A" & Cells(Rows.count, "B").End(xlUp).Row)

Range("F2").Value = "=XLOOKUP($B2,Unit_MonthYear,XLOOKUP($E2,Unit_FamSubDiv,ROUND(Unit_Fcst,0)))"
Range("F2").AutoFill Range("F2:F" & Cells(Rows.count, "B").End(xlUp).Row)

Range("G2").Value = "=XLOOKUP($B2,ASP_MonthYear,XLOOKUP($E2,ASP_FamSubDiv,ROUND(ASP_Fcst,0)))"
Range("G2").AutoFill Range("G2:G" & Cells(Rows.count, "B").End(xlUp).Row)

Range("H2").Value = "=XLOOKUP($B2,Rev_MonthYear,XLOOKUP($E2,Rev_FamSubDiv,ROUND(Rev_Fcst,0)))"
Range("H2").AutoFill Range("H2:H" & Cells(Rows.count, "B").End(xlUp).Row)

結束子