Question

我正在处理将矩阵表转换为3列的代码。矩阵表在sheet1上，我到列的传输在sheet2上。

我正在使用4个数组转换矩阵。 1个ID数组，第二个数组用于水平列中的日期，第二个数组用于垂直列中的日期，第三个数组用于矩阵中与垂直和水平日期匹配的值。我想根据与垂直日期的匹配将id2的数组，水平日期的数组和值的数组写入矩阵。

我的代码工作正常，除了以下事实：我想将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

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

1 个答案: