vba excel 宏：对于每个单元格在一行中有一个值，在下面插入一个带有该值的行
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/24762774/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
excel macro: for each cell with a value in a row, insert a row below with that value
提问by user3776607
I have a worksheet with ~700 rows, and 7 columns. I need each row to have just one entry. I.e. if row 1 has cell values in column A,B and C, then two new rows should be created so row 1 has one value in column A, row 2 has one value in column B and row 3 has one value in column C.
我有一个大约 700 行和 7 列的工作表。我需要每一行只有一个条目。即，如果第 1 行在 A、B 和 C 列中有单元格值，则应创建两个新行，以便第 1 行在 A 列中有一个值，第 2 行在 B 列中有一个值，第 3 行在 C 列中有一个值。
I have spent a couple hours on this (sadly) but I'm so bad, I'm not getting anywhere:
我已经花了几个小时（可悲的是）但我太糟糕了，我什么也没有：
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
My issue is that this code deletes the row beneath it (which is not suppose to happen) and it inserts two rows instead of one.
我的问题是这段代码删除了它下面的行（这不应该发生）并且它插入了两行而不是一行。
Thanks a ton!
万分感谢！
回答by Alex P
I'd read your data into an array, delete the data on the worksheet, and then write back to the worksheet in a single column (whilst checking for blanks)
我将您的数据读入一个数组，删除工作表上的数据，然后在单列中写回工作表（同时检查空格）
Example:
例子：
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
