Question

我有一个包含约700行和7列的工作表。我需要每一行只有一个条目。即如果第1行在A，B和C列中有单元格值，则应创建两个新行，因此第1行在A列中有一个值，第2行在B列中有一个值，第3行在C列中有一个值。 / p>

我花了几个小时（遗憾地），但我很糟糕，我没有到达任何地方：

Sub TThis()
Dim rng As Range
Dim row As Range
Dim cell As Range

'just testing with a basic range
Set rng = Range("A1:C2") 

For Each row In rng.Rows
  For Each cell In row.Cells
If cell.Value <> "" Then
        'write to adjacent cell
        Set nextcell = cell.Offset(1, 0)
        nextcell.Value = cell.Value
        nextcell.EntireRow.Insert
    End If
Next cell
Next row
End Sub

我的问题是这段代码会删除它下面的行（不会发生这种情况）它插入两行而不是一行。

非常感谢！

Answer 1

将您的数据读入数组，删除工作表上的数据，然后在单个列中回写工作表（同时检查空白）

示例：

Sub OneColumnData()
    Dim rng As Range, ids As Range, arr() As Variant, rw As Integer, col As Integer, counter As Integer

    Set rng = Range("A1:C5")
    Set ID = Range("G1:G5")

    arr = rng.Value
    counter = 1

    rng.ClearContents

    For rw = 1 To UBound(arr, 1)
        For col = 1 To UBound(arr, 2)
            If arr(rw, col) <> vbNullString Then
                Range("A" & counter) = arr(rw, col)
                Range("B" & counter) = ID(rw)
                counter = counter + 1
            End If
        Next col
    Next rw
End Sub

excel宏：对于每行中有一个值的单元格，在该行下面插入一行该值

1 个答案: