用于 A 列范围的 Excel vba 复制不同列的值

Question

我正在创建一个新的访问数据库，以导入我在 excel 中管理的数据，用于多个用户的测试结果。但是，由于布局以及列和文件的数量，我的 excel 文件很难准备文件手动导入。 这就是为什么我一直在寻找任何 vba 代码来完成工作:)

该文件在 A 列中包含测试引用，然后在每一列中包含一个用户的名称和每个测试的相应分数。 我需要复制每个用户的姓名以及随后块中的所有测试参考和分数，所以只使用 3 列，一列用于用户名，然后是测试参考，最后是测试分数。

我认为它不是那么清楚（但不能解释得更好，对不起），所以让我上传2张当前工作表数据示例的图片以及运行代码后数据应该如何处理。

非常感谢提前

当前工作表数据

运行代码后数据应该如何处理

Answer 1

好的，这应该能够像您正在寻找的那样循环。 这有点僵硬，因为我对你的书的布局不太了解。 现在，它假定Sheets(1)是源，而Sheets(2)是目标。

Sub test()

    Dim lastCol As Long
    lastCol = Sheets(1).Cells(2, Columns.count).End(xlToLeft).Column

    Dim col As Long
    For col = 2 To lastCol
        userLoop (col)
    Next col

End Sub

Sub userLoop(ByVal col As Long)

    Dim lastRow_sheet1 As Long
    lastRow_sheet1 = Sheets(1).Cells(Rows.count, "A").End(xlUp).row

    Dim lastRow_sheet2 As Long
    lastRow_sheet2 = Sheets(2).Cells(Rows.count, "A").End(xlUp).row + 1
    If lastRow_sheet2 = 1 Then lastRow_sheet2 = 2

    Dim i As Long
    For i = 2 To lastRow_sheet1
        With Sheets(2)
            .Cells(lastRow_sheet2, "A").Value2 = Sheets(1).Cells(1, col).Value2
            .Cells(lastRow_sheet2, "B").Value2 = Sheets(1).Cells(i, "A").Value2
            .Cells(lastRow_sheet2, "C").Value2 = Sheets(1).Cells(i, col).Value2
        End With

        lastRow_sheet2 = lastRow_sheet2 + 1
    Next i

End Sub