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

Question

我正在编写将矩阵表转换为 3 列的代码。矩阵表位于sheet1上，我的列转移位于sheet2上。

我使用 4 个数组来转换矩阵。 1 个数组用于 ids，第二个数组用于水平列中的日期，第二个数组用于垂直数组中的日期，第三个数组用于矩阵中匹配垂直和水平日期的值。我想根据与垂直日期的匹配写入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

Answer 1

事实上，代码很糟糕..通常为了满足您的需求，在设置工作表之前放置这两行

Dim r As Long
r = 1

然后在这一行之后和循环内部

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

放置用于递增变量“r”的行

r = r + 1

现在您可以通过以下行使用此变量

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