Excel将数据从行移动到列中
对不起，我觉得这可能是超级基本的，但我试图使用Excel和VBA将数据从每行的多个单元格按特定的顺序移动到空列。 有些单元格可能没有数据，所以我必须检查一下，并沿着Value <> Empty行跳过空行。
基本上，我试图做的是看起来像这样的表（与空列A）：
B1 C1 D1 E1 B2 C2 D2 [E2empty] B3 C3 D3 E3
在A列中这样设置：
B1 C1 D1 E1 B2 C2 D2 B3 C3 D3 E3
它将一次一行地input到新列中。
我想我想弄清楚如何在代码中说下面的内容
In Row 1, check if cell B is empty. If not, move Value to column A, first avaible cell, next cell in row 1, (repeat). Next Row( do the same as row 1.)
所以我正在考虑使用For i = 1 To rwcnt其中rwcnt由CountA(Range("B:B"))定义CountA(Range("B:B"))要按顺序执行行，然后在单元格的for-statement中执行类似的事情（也许j = B To E? ）。
所以我的总体目标是扫描我的范围(MyRange = ActiveSheet.Range("B1:E" & rwcnt))并按照顶部所述的顺序将所有内容移动到列A中，但我不知道如何将数据移动到A列顺序。 任何关于如何做到这一点的build议将是非常有帮助的。
循环遍历所有使用的行，从该行中的B开始循环列。 检查单元格是否不是空的。 把它写到下一个单元格。
在你的VBA IDE进入工具菜单并select参考。 select“Microsoft脚本运行时”
Dim lRow As Long Dim lRowWrite as long Dim lCol As Long Dim ws As Excel.Worksheet Dim ts As TextStream Dim fs As FileSystemObject 'Create the text file to write to Set fs = New FileSystemObject Set ts = fs.CreateTextFile("C:\Temp\test.txt", True, False) Application.ScreenUpdating = False Set ws = Application.ActiveSheet lRowWrite = 1 lRow = 1 'Loop through all the rows. Do While lRow <=ws.UsedRange.Rows.count 'Loop through all the columns lCol = 2 Do While lCol <=ws.UsedRange.Columns.count 'Check if it is empty If not isempty(ws.Cells(lRow, lCol)) Then 'Not empty so write it to the text file ts.WriteLine ws.Cells(lRow, lCol) End If lCol = lCol + 1 Loop lRow = lRow + 1 ws.Range("A" & lRow).Activate Loop Application.ScreenUpdating = True ts.Close: Set ts = Nothing Set fs = Nothing
尝试这个：
Sub test() Dim lastCol As Long, lastRow As Long, k As Long, i As Long, colALastRow As Long Dim rng As Range Dim ws As Worksheet 'Columns(1).Clear ' uncomment this if you want VB to force Col. A to be cleared Application.ScreenUpdating = False Set ws = ActiveSheet lastCol = ws.UsedRange.Columns.Count 'This will get the last column lastRow = ws.UsedRange.Rows.Count 'this will get the last used row k = 2 'Set k to 2, to start in Col B colALastRow = 1 'This starts at 1, since your entire Column A is empty With ws For i = 1 To lastRow lastCol = .Cells(i, 2).End(xlToRight).Column Set rng = .Range(.Cells(i, 2), .Cells(i, lastCol)) ' rng.Select rng.Copy .Range(.Cells(colALastRow, 1), .Cells(colALastRow + (lastCol), 1)).PasteSpecial Paste:=xlPasteAll, operation:=xlNone, skipblanks:=False, Transpose:=True Application.CutCopyMode = False colALastRow = .Cells(1, 1).End(xlDown).Row + 1 Next i End With Application.ScreenUpdating = True MsgBox ("Done!") End Sub
编辑：改变lastCol ， lastRow等从Integer到Long ，因为将有超过32,767行。
编辑2：我注释掉rng.Select 。 这是因为没有理由为macrosselect它。 我只有在那里，因为当我通过macros（使用F8），我想确保它抓住了正确的范围。 这是，所以你可以评论这一点。 它甚至可能使其运行稍快:)