Arrays 将数组的结果写入下一个可用单元格

我正在编写代码，将矩阵表转换为3列。矩阵表在表1中，我的转换到列在表2中

我使用4个数组来转换矩阵。1个数组表示ID，第2个数组表示水平列中的日期，第2个数组表示垂直数组中的日期，第3个数组表示矩阵中匹配垂直和水平日期的值。我想在sheet2中写入ID数组、水平日期数组和基于与垂直日期匹配的矩阵值数组。

我的代码运行良好，除了我希望将sheet2中数组的结果作为下一个可用单元格写入（与读取的数组不在同一级别）之外

这是在运行代码并根据垂直和水平日期之间的匹配在矩阵中查找值后，在sheet2中写入的结果：

我应该向代码中添加什么，以便将写入sheet2的数组的结果写入下一个可用单元格

Sub Test()
  Dim i As Integer, d As Integer, IntLastRow As Integer, IntLastCol As Integer
  Dim w1 As Worksheet, w2 As Worksheet

  Set w1 = Worksheets("Sheet1")
  Set w2 = Worksheets("Sheet2")
  IntLastRow = w1.Cells(Rows.Count, 1).End(xlUp).Row
  IntLastCol = w1.Cells(2, Columns.Count).End(xlToLeft).Column

  Dim Ary_ids() As Variant
  Dim Ary_Months_Vertic() As Variant 'dates to match horiz dates (no output)
  Dim Ary_Months_Horizont() As Variant 'dates to write to sheet2
  Dim Ary_Values() As Variant

  With w1
    ReDim Ary_ids(IntLastRow, 1)
    ReDim Ary_Months_Vertic(IntLastRow, 2)
    ReDim Ary_Months_Horizont(2, IntLastCol)
    ReDim Ary_Values(IntLastRow, IntLastCol)

    For i = 1 To UBound(Ary_ids, 1)
      For d = 1 To UBound(Ary_Months_Horizont, 2)
        Ary_ids(i, 1) = .Cells(i + 2, 1)             'Array ids
        Ary_Months_Vertic(i, 2) = .Cells(i + 2, 2)   'Array dates/rows
        Ary_Months_Horizont(2, d) = .Cells(2, d + 2) 'Array dates/cols
        Ary_Values(i, d) = .Cells(i + 2, d + 2)      'Array values

        If Ary_Values(i, d) <> 0 Then   'If values of matirx are non-zero
          If Ary_Months_Horizont(2, d) = Ary_Months_Vertic(i, 2) Then 'horiz=vert
            If Ary_Months_Horizont(2, d) <> "" Then 'If horiz dts <> emptystring
              w2.Cells(i + 1, 1) = Ary_ids(i, 1) 'labels only for these dates
              w2.Cells(d + 1, 2) = Ary_Months_Horizont(2, d) 'not-nothing months
              w2.Cells(i + 1, 3) = Ary_Values(i, d) 'Write amounts respectively
            End If
          End If
        End If
      Next d
    Next i
  End With
End Sub

子测试（）
Dim i为整数，d为整数，IntLastRow为整数，IntLastCol为整数
尺寸w1作为工作表，w2作为工作表
设置w1=工作表（“表1”）
集合w2=工作表（“表2”）
IntLastRow=w1.Cells（Rows.Count，1）.End（xlUp）.Row
IntLastCol=w1.Cells（2，Columns.Count）.End（xlToLeft）.Column
Dim Ary_ID（）作为变量
Dim Ary_Months_Vertic（）作为变量的日期，以匹配水平日期（无输出）
Dim Ary_Months_Horizont（）作为可变日期写入工作表2
Dim Ary_Values（）作为变量
与w1
重播ID（最后一行，1）
径向月数（最后一行，2）
径向月横向（2个，IntLastCol）
径向值（IntLastRow、IntLastCol）
对于i=1到UBound（Ary_id，1）
对于d=1至UBound（三个月水平，2）
Ary_-id（i，1）=.单元（i+2，1）'数组id
Ary_Months_Vertic（i，2）=.单元格（i+2，2）'数组日期/行
Ary_Months_Horizont（2，d）=.单元格（2，d+2）的数组日期/列
Ary_值（i，d）=.单元格（i+2，d+2）的数组值
如果Ary_值（i，d）为0，那么‘如果matirx的值为非零
如果水平面（2，d）=垂直面（i，2），则水平面=垂直面
如果水平面（2，d）“，那么”如果水平面dts清空
w2.单元格（i+1，1）=仅用于这些日期的Y_ID（i，1）”标签
w2.细胞（d+1,2）=三个月水平（2,d）“非零月”
w2.单元格（i+1,3）=分别为Y_值（i，d）的写入量
如果结束
如果结束
如果结束
下一个d
接下来我
以
端接头

事实上，代码很糟糕。通常，为了满足您的需要，请在设置工作表之前填写这两行

Dim r As Long
r = 1

然后在这条线之后，在环路内部

If Ary_Months_Horizont(2, d) <> "" Then

现在您可以将此变量与以下行一起使用

w2.Cells(r, 1) = Ary_ids(i, 1)
w2.Cells(r, 2) = Ary_Months_Horizont(2, d)
w2.Cells(r, 3) = Ary_Values(i, d)

更新： 你可以试试这个代码

Sub Test()
Dim ws As Worksheet, sh As Worksheet, r As Long, m As Long, x

Set ws = ThisWorkbook.Worksheets("Sheet1")
Set sh = ThisWorkbook.Worksheets("Sheet2")

sh.Range("A1").Resize(1, 3).Value = Array("Name", "Date", "Value")
m = 1

For r = 3 To ws.Cells(Rows.Count, 1).End(xlUp).Row
    x = Application.Match(ws.Cells(r, 2), ws.Range(ws.Cells(2, 3), ws.Cells(2, ws.Cells(2, Columns.Count).End(xlToLeft).Column)), False)
    If Not IsError(x) Then
        If ws.Cells(r, x + 2).Value <> "" Then
            m = m + 1
            sh.Cells(m, 1).Resize(1, 2).Value = ws.Cells(r, 1).Resize(1, 2).Value
            sh.Cells(m, 3).Value = ws.Cells(r, x + 2).Value
        End If
    End If
Next r
End Sub

子测试（）
将ws标注为工作表，sh标注为工作表，r标注为长，m标注为长，x标注为长
设置ws=ThisWorkbook.Worksheets（“Sheet1”）
设置sh=ThisWorkbook.Worksheets（“Sheet2”）
sh.Range（“A1”）.Resize（1，3）。Value=数组（“名称”、“日期”、“值”）
m=1
对于r=3到ws.Cells（Rows.Count，1）.End（xlUp）.Row
x=Application.Match（ws.Cells（r，2），ws.Range（ws.Cells（2，3），ws.Cells（2，ws.Cells（2，Columns.Count）.End（xlToLeft.Column）），False）
如果不是IsError（x），则
如果ws.Cells（r，x+2）.Value为“”，则
m=m+1
sh.Cells（m，1）.Resize（1，2）.Value=ws.Cells（r，1）.Resize（1，2）.Value
sh.Cells（m，3）.Value=ws.Cells（r，x+2）.Value
如果结束
如果结束
下一个r
端接头

非常感谢。两者都能完美地工作。不过我有一个问题，我知道我的代码可能不是最短和最聪明的，但这是因为我没有那么先进。你能详细告诉我为什么我的代码很糟糕吗？在哪些方面？不客气。您的代码使用了大量数组，我认为这是不必要的。。首先尝试使用简单的代码，找到一个完美的解决方案

Sub Test()
Dim ws As Worksheet, sh As Worksheet, r As Long, m As Long, x

Set ws = ThisWorkbook.Worksheets("Sheet1")
Set sh = ThisWorkbook.Worksheets("Sheet2")

sh.Range("A1").Resize(1, 3).Value = Array("Name", "Date", "Value")
m = 1

For r = 3 To ws.Cells(Rows.Count, 1).End(xlUp).Row
    x = Application.Match(ws.Cells(r, 2), ws.Range(ws.Cells(2, 3), ws.Cells(2, ws.Cells(2, Columns.Count).End(xlToLeft).Column)), False)
    If Not IsError(x) Then
        If ws.Cells(r, x + 2).Value <> "" Then
            m = m + 1
            sh.Cells(m, 1).Resize(1, 2).Value = ws.Cells(r, 1).Resize(1, 2).Value
            sh.Cells(m, 3).Value = ws.Cells(r, x + 2).Value
        End If
    End If
Next r
End Sub