将多列转换为一个大列（Excel 2010） [英] Convert Multiple Columns to One Large Column (Excel 2010)

问题描述

我想将15,096个文本列（每个单元格一个字）转换为一个大列，包括原始列中的每个单元格。我的原始列大小有所不同（即一列可能有4个单元格/行，而另一列可能有100个单元格/行）。

I would like to convert 15,096 columns of text (one word per cell) to one large column including every cell from the original columns. My original columns vary in size (i.e. one column may have 4 cells/rows, while another may have 100 cells/rows).

我没有VBA的经验，但是已经记录了一个宏手动做一些这个宏，它是永远的。请帮助我可以设置的东西，去喝咖啡，回来看看完成的工作。 （注意：有些列有1个字/行...这使得我的宏在每次遇到其中一个时抛出错误）。

I have no experience with VBA, but have recorded a macro to do this somewhat manually and it is taking forever. Please help with something that I could set and go get coffee and come back to see the job done. (NOTE: Some columns have 1 word/row...this has made my macro throw an error every time it encounters one of these).

谢谢！希望有人可以帮忙
-Mike

Thank you! Hope someone can help. -Mike

推荐答案

如果您希望所有单元格在一列中对齐，可以使用以下代码： p>

If you want all your cells aligned in one column, you can use this code:

Sub ToArrayAndBack()
Dim arr As Variant, lLoop1 As Long, lLoop2 As Long
Dim arr2 As Variant, lIndex As Long

'turn off updates to speed up code execution
With Application
    .ScreenUpdating = False
    .EnableEvents = False
    .Calculation = xlCalculationManual
    .DisplayAlerts = False
End With


ReDim arr2(ActiveSheet.UsedRange.Cells.Count - ActiveSheet.UsedRange.SpecialCells(xlCellTypeBlanks).Count)

arr = ActiveSheet.UsedRange.Value


For lLoop1 = LBound(arr, 1) To UBound(arr, 1)
    For lLoop2 = LBound(arr, 2) To UBound(arr, 2)
        If Len(Trim(arr(lLoop1, lLoop2))) > 0 Then
            arr2(lIndex) = arr(lLoop1, lLoop2)
            lIndex = lIndex + 1
        End If
    Next
Next

Sheets.Add
Range("A1").Resize(, lIndex + 1).Value = arr2

Range("A1").Resize(, lIndex + 1).Copy
Range("A2").Resize(lIndex + 1).PasteSpecial Transpose:=True
Rows(1).Delete

With Application
    .ScreenUpdating = True
    .EnableEvents = True
    .Calculation = xlCalculationAutomatic
    .DisplayAlerts = True
End With


End Sub

如果要连接每一行，请改用。它会将您的单元格整合到一个新的工作表中。

If you want to concatenate each row, use this instead. It will consolidate your cells in a new sheet.

Sub Consolidate()
Dim shtDest As Worksheet, shtOrg As Worksheet
Dim lLastRow As Long, lLastCol As Long, lLoop As Long
Dim sFormula  As String

'turn off updates to speed up code execution
With Application
    .ScreenUpdating = False
    .EnableEvents = False
    .Calculation = xlCalculationManual
    .DisplayAlerts = False
End With


Set shtOrg = ActiveSheet
lLastCol = shtOrg.UsedRange.Columns.Count
lLastRow = shtOrg.Cells(Rows.Count, 1).End(xlUp).Row

Set shtDest = Sheets.Add

For lLoop = 1 To lLastCol
    sFormula = sFormula & "'" & shtOrg.Name & "'!RC" & lLoop & ","
Next lLoop

sFormula = Left(sFormula, Len(sFormula) - 1)

shtDest.Range("A1:A" & lLastRow).FormulaR1C1 = "=concatenate(" & sFormula & ")"
shtDest.Range("A1:A" & lLastRow).Value = shtDest.Range("A1:A" & lLastRow).Value


With Application
    .ScreenUpdating = True
    .EnableEvents = True
    .Calculation = xlCalculationAutomatic
    .DisplayAlerts = True
End With


End Sub

或如果您希望你的单元格被空格隔开

or if you want your cells separated by spaces

Sub Consolidate()
Dim shtDest As Worksheet, shtOrg As Worksheet
Dim lLastRow As Long, lLastCol As Long, lLoop As Long
Dim sFormula  As String

Const sSeparator As String = " "

'turn off updates to speed up code execution
With Application
    .ScreenUpdating = False
    .EnableEvents = False
    .Calculation = xlCalculationManual
    .DisplayAlerts = False
End With


Set shtOrg = ActiveSheet
lLastCol = shtOrg.UsedRange.Columns.Count
lLastRow = shtOrg.Cells(Rows.Count, 1).End(xlUp).Row

Set shtDest = Sheets.Add

For lLoop = 1 To lLastCol
    sFormula = sFormula & "'" & shtOrg.Name & "'!RC" & lLoop & "&""" & sSeparator & ""","
Next lLoop

sFormula = Left(sFormula, Len(sFormula) - 1)

shtDest.Range("A1:A" & lLastRow).FormulaR1C1 = "=trim(concatenate(" & sFormula & "))"
shtDest.Range("A1:A" & lLastRow).Value = shtDest.Range("A1:A" & lLastRow).Value


With Application
    .ScreenUpdating = True
    .EnableEvents = True
    .Calculation = xlCalculationAutomatic
    .DisplayAlerts = True
End With


End Sub

这篇关于将多列转换为一个大列（Excel 2010）的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！