Question

嗨，我对vba不是很熟悉。但我想出了以下内容，将包含多列的电子表格转换为两列。示例显示了包含多个项目的名称。我需要一行代表每个项目的名称。

您可以看到每行的长度可以更改。我知道有多少行。我已经制作了以下脚本，但似乎无法让它发挥作用。关于如何修复的任何建议都非常有帮助！

这就是我所拥有的：

name1 | item1 | item2 | item3 | ITEM4

name2 | item5 | item3 | item19

这就是我需要的：

name1 | ITEM1

name1 | ITEM2

name1 |项目3

name1 | ITEM4

name2 | ITEM5

name2 |项目3

name2 | item19

Sub moveToRows()
Dim name As String,  item as String,
Dim r As Double, c As Double, r2 As Double, l As Double
Sheets("Sheet1").Select
r = 1
c = 1
r2 = 1
Do While r < 5000
    ActiveSheet.Cells(r, c).Select
    name = ActiveCell.Value
    l = ActiveRow.Length
    Do While c <= l
        item = ActiveCell.Offset(0, c)
        Sheets("Sheet2").Range.Cells(r2, 1).Value = name
        Sheets("Sheet2").Range.Cells(r2, 2).Value = item
        c = c + 1
        r2 = r2 + 1
        Cells(r, c).Select
    Loop
    c = 1
    r = r + 1
Loop

End Sub

Answer 1

我能够按照建议解决IsEmpty的问题。更改输出位置，如变量oRow中所示。

Sub moveToRows()
Dim name As String, item As String
Dim r As Double, oRow As Double
Range("A1").Select
oRow = 5000

For r = 1 To ActiveCell.End(xlDown).Row
    Cells(r, 2).Select
    name = ActiveCell.Offset(0, -1).Value
    If IsEmpty(ActiveCell) Then
        Cells(oRow, 1).Value = name
        oRow = oRow + 1
    End If

    Do Until IsEmpty(Selection)
        item = ActiveCell.Value
        Cells(oRow, 1).Value = name
        Cells(oRow, 2).Value = item
        ActiveCell.Offset(0, 1).Select
        oRow = oRow + 1
        item = ""
    Loop

Next

End Sub

Answer 2

此解决方案速度更快，原因是：

读取直到找到第一个空单元格
不使用通常很慢的“选择”

您在这里：

Sub moveToRows()
Dim name As String, item As String

Dim shin As Worksheet
Dim shout As Worksheet

' Edit the sheet names here if needed
Set shin = ActiveWorkbook.Sheets("Sheet1")
Set shout = ActiveWorkbook.Sheets("Sheet2")

Dim r As Double, c As Double, r2 As Double, l As Double

r = 1
r2 = 1

Do
    c = 1
    name = shin.Cells(r, c)
    If name = "" Then Exit Do

    Do
        c = c + 1
        item = shin.Cells(r, c)
        If item = "" Then Exit Do

        shout.Cells(r2, 1).Value = name
        shout.Cells(r2, 2).Value = item

        r2 = r2 + 1
    Loop

    r = r + 1
Loop

End Sub

VBA将许多列转换为两列 - 我做错了什么？

2 个答案: