VBA 二维数组

Question

我有一个关于使用 VBA 向二维数组添加值的问题。情况如下：假设我有一行数据。

(第一行是tile, q:quiz, s:semester)

Student name  q1_s1  q2_s2  q3_s1  average_s1 q1_s2  q2_s2  q3_s2 average_s2

 David.          5      6      7       6.       8.     9.    10.   9

该行存储在 sheet1 中，现在在 sheet 2（名为 David）中，我想复制这些数据并以这种方式列出数据。

             average   quiz1.   quiz2.    quiz3


semester_1.    6.        5.       6.        7

semester_2.    9.        8       9      10

谁能帮助我们解决这个问题？我应该使用二维数组来存储它们吗？

非常感谢！！！

Answer 1

使用数组。这会读入标头，但仅输出重新排列的数据而没有新标头。这是为了处理超过 1 个人行，以防您添加数据。请注意，我已经纠正了我认为您重复 q2_s2 的错字。第一个实例应该是q2_s1。

Option Explicit
Public Sub test()
    Dim arr(), ws As Worksheet, i As Long, j As Long, r As Long, c As Long, outputArr()
    Set ws = ThisWorkbook.Worksheets("Sheet5"): arr = ws.[B1:I2].Value '<=adjust if more rows
    ReDim outputArr(1 To 2 * (UBound(arr, 1) - 1), 1 To UBound(arr, 2) / 2)
    For i = 2 To UBound(arr, 1)
        For j = LBound(arr, 2) To UBound(arr, 2) Step 4
            r = r + 1
            outputArr(r, 1) = arr(i, j + 3)
            outputArr(r, 2) = arr(i, j)
            outputArr(r, 3) = arr(i, j + 1)
            outputArr(r, 4) = arr(i, j + 2)
        Next
    Next
    ws.Cells(5, 1).Resize(UBound(outputArr, 1), UBound(outputArr, 2)) = outputArr
End Sub

---

如果学生可以有不同的学期数，请将您的表格设置为最大可能的学期数，并将这些学期留空，不对给定学生进行测验，然后使用代码：

Option Explicit
Public Sub test()
    Dim arr(), ws As Worksheet, i As Long, j As Long, r As Long, c As Long, outputArr(), numberOfColumns As Long
    Set ws = ThisWorkbook.Worksheets("Sheet5"): arr = ws.[B1:M3].Value
    numberOfColumns = UBound(arr, 2) / 4
    ReDim outputArr(1 To numberOfColumns * (UBound(arr, 1) - 1), 1 To UBound(arr, 2) / numberOfColumns)
    For i = 2 To UBound(arr, 1)
        For j = LBound(arr, 2) To UBound(arr, 2) Step 4
            r = r + 1
            outputArr(r, 1) = arr(i, j + 3)
            outputArr(r, 2) = arr(i, j)
            outputArr(r, 3) = arr(i, j + 1)
            outputArr(r, 4) = arr(i, j + 2)
        Next
    Next
    ws.Cells(Ubound(arr,1) + 5 , 1).Resize(UBound(outputArr, 1), UBound(outputArr, 2)) = outputArr
End Sub

最多 3 个学期且 1 名学生仅完成 2 个学期的示例布局：

Answer 2

如果我理解您的问题，您不需要二维数组，而是将数据从 sheet1 复制到 sheet2。

这是一个例子：

Sub test()
'copy data from sheet1 into sheet2(named David)
'in this code i know where are the data into sheet1 and where i want to put into sheet2(named David).

'execute macro into sheet1
Dim studentName As String

studentName = Cells(2, 1) 'in this example is David

With Sheets(studentName) 'call sheet David

    'semestre1
    .Cells(2, 3) = Cells(2, 2) 'put into cells(2,3)sheet David the data of the sheet1 is q1_s1 in semestre1 quiz1
    .Cells(2, 4) = Cells(2, 3) 'q2_s1 into semestre1 quiz2
    .Cells(2, 5) = Cells(2, 4) 'q3_s1 into semestre1 quiz3
    .Cells(2, 2) = Cells(2, 5) 'average semestre1

    'semestre2
    .Cells(3, 3) = Cells(2, 6) 'put into cells(2,3)sheet David the data of the sheet1 is q2_s1 in semestre2 quiz1
    .Cells(3, 4) = Cells(2, 7) 'q2_s2 into semestre2 quiz2
    .Cells(3, 5) = Cells(2, 8) 'q3_s2 into semestre2 quiz3
    .Cells(3, 2) = Cells(2, 9) 'average semestre2

End With
End Sub

sheet1 数据在哪里

sheet2(David) 信息放在哪里

它已经过测试并且可以工作。 希望对你有帮助