Question

我在下面的代码将一个工作表中的多个列组合成一个新的/现有的（名为MasterList）到一列。

我遇到的问题是每个列都有一个列名称，该列名称将被放入新工作表中。列名始终位于第1行。

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

Dim ws As Worksheet
Dim found As Boolean
found = False
For Each ws In ThisWorkbook.Sheets
    If ws.Name = "MasterList" Then
        found = True
        Exit For
    End If
Next
If Not found Then
    Sheets.Add.Name = "MasterList"
End If

Set ws = ThisWorkbook.Sheets("MasterList")
With ws
     .Range("A1").Resize(, lIndex + 1).Value = arr2

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

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


End Sub

总结一下，我想使用此代码将一个工作表中的多个列组合成另一个没有列名的列。

Answer 1

arr = ActiveSheet.UsedRange.Resize(ActiveSheet.UsedRange.Rows.Count-1,ActiveSheet.UsedRange.Columns.Count).Offset(1,0)

This should do the trick

Excel：将多列组合到不带列名称的新工作表中

1 个答案: