在Excel中将所有单元格移动到新的单列中

我有一个excel文件，比如

我想将所有填充信息的单元格转换为一列。喜欢 我该怎么做？

---

我在互联网上搜索了一下，发现只有一行中的细胞转化为一个细胞。但是我找不到像这样的东西。你能帮我一下吗这是我为这类工作保留的一些代码。它假定每行中的值是连续的，即数据集中没有空白单元格。它还假设您在触发数据时位于包含数据的工作表上，并且希望将数据放置在新工作表上

Option Explicit

Sub Columnise()
    Dim shtSource As Worksheet
    Dim shtTarget As Worksheet
    Dim rngRow As Range, rngCol As Range
    Dim lCount As Long

    Set shtSource = ActiveSheet 'Or specify a sheet using Sheets(<name>)
    Set rngCol = Range("A1", Range("A" & Rows.Count).End(xlUp))

    Set shtTarget = Sheets.Add 'Or specify a sheet using Sheets(<name>)

    'Define starting row for the data
    lCount = 1

    'Loop through each row
    For Each rngRow In rngCol
        'On each row, loop through all cells until a blank is encountered
        Do While rngRow.Value <> ""
            'Copy the value to the target
            shtTarget.Range("A" & lCount).Value = rngRow.Value
            'Move one space to the right
            Set rngRow = rngRow.Offset(0, 1)
            'Increment counter
            lCount = lCount + 1
        Loop
    Next rngRow

End Sub

选项显式
分栏（）
将shtSource设置为工作表
将SHT目标设置为工作表
变暗rngRow As Range，rngCol As Range
暗淡如长
设置shtSource=ActiveSheet'或使用Sheets（）指定工作表
设置rngCol=Range（“A1”，Range（“A”和Rows.Count）。End（xlUp））
设置shtTarget=Sheets.Add'或使用Sheets（）指定工作表
'定义数据的起始行
lCount=1
'循环通过每一行
对于rngCol中的每个rngRow
'在每行上，循环遍历所有单元格，直到遇到空白
在rngRow.Value“”时执行此操作
'将值复制到目标
shtTarget.Range（“A”&lCount.Value=rngRow.Value
'向右移动一个空格
设置rngRow=rngRow.Offset（0,1）
'增量计数器
lCount=lCount+1
环
下一个成长
端接头

您应该将所有数据放在新工作表的一列中

Option Explicit

Sub Columnise()
    Dim shtSource As Worksheet
    Dim shtTarget As Worksheet
    Dim rngRow As Range, rngCol As Range
    Dim lCount As Long

    Set shtSource = ActiveSheet 'Or specify a sheet using Sheets(<name>)
    Set rngCol = Range("A1", Range("A" & Rows.Count).End(xlUp))

    Set shtTarget = Sheets.Add 'Or specify a sheet using Sheets(<name>)

    'Define starting row for the data
    lCount = 1

    'Loop through each row
    For Each rngRow In rngCol
        'On each row, loop through all cells until a blank is encountered
        Do While rngRow.Value <> ""
            'Copy the value to the target
            shtTarget.Range("A" & lCount).Value = rngRow.Value
            'Move one space to the right
            Set rngRow = rngRow.Offset(0, 1)
            'Increment counter
            lCount = lCount + 1
        Loop
    Next rngRow

End Sub

编辑添加：由于您提到您的数据确实包含空白单元格，它变得更加复杂。我们将希望添加一种方法，以继续到数据的实际结尾，而不仅仅是循环直到找到一个空白单元格。我们将在。。。这方面的条件：

Do While rngCell.Column <= Cells(rngCell.Row, Columns.Count).End(xlToLeft).Column

---

Do While rngCell.Column您可以使用concatenate（&），也可以简单地保存为文本或csv，然后导入到单个列中。根据您的数据集大小，这更适合vba，而不是公式。公式很可能是数组类型的公式，对于大型数据集，这将导致较长的计算时间。实际上，有三个选项—您可以使用“复制/粘贴|转置”手动执行，也可以使用丑陋的公式执行，该公式将留下空白单元格，或者使用VBA执行。VBA可能是最简单的选择，尤其是当您需要多次执行此操作时。@Werf我认为有最快的解决方案。这是一个快速循环：对于每一行，将数据复制并转置到一个新的工作表a列。然后下一行，从该列的末尾开始，然后继续转置。尝试此方法在大多数情况下都有效，但我的excel包含空单元格，当这个公式遇到一个空单元格时，它会移动另一行，而不是将其他单元格直接看向空单元格。我删除了代码中的“While rngRow.Value”“”部分。可能它运行了所有的细胞，但不到1分钟。所以对我来说就足够了。现在我相信当我删除那个部分时，它不会移动其他行。如果没有尺寸标注，这可能是不可能的。好吧，如果有空单元格，我们需要一种更精细的方法来识别何时到达行的末尾。我已经加入了一个替代方案，而。。。您尝试的条件。缺少rngCell的定义。编辑：我定义rngCell就像Dim rngCell，它以一张空的新工作表结束。