Question

代码（下面）组合了活动工作表中的所有列，将它们转换为名为Sheet3（Masterlist）的工作表中的一个列。

当所有列组合在一起时，我需要从第2行开始。这是因为第1行具有列名。

另外，我宁愿使用Sheet1（Orders）而非活动表。

此代码根据Yaegz的建议进行修改。我现在在第26行没有For的情况下接下来：

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(Sheet1.UsedRange.Cells.Count - Sheet1.UsedRange.SpecialCells(xlCellTypeBlanks).Count)

arr = Sheet1.UsedRange.Value

Set myRange = Worksheets("Orders").Range("A1:A" & _
Worksheets("Orders").Cells(Worksheets("Orders").Rows.Count, 1).End(xlUp).Row)
i = 2
Do While i <= myRange.Rows.Count
     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
    i = i + i
Loop

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

Sheet1是表单代码。订单是工作表名称。

Answer 1

如果要指向特定工作表而不是活动工作表： Application.Worksheets("name of your sheet")代替ActiveSheet

错误消息是因为do while打开了一个循环，并以loop关键字关闭，如下所示：

 Do while i<10
    Your Code
    i=i+1
 Loop

Answer 2

假设您的代码有效，如果您想要正确的Do While循环，请使用以下代码。听起来您正试图初始化代码应该从哪里开始。如果是这种情况，则Do While循环不是要走的路。

arr = ActiveSheet.UsedRange.Value
Set myRange = Worksheets("Sheet1").Range("A1:A" & _
Worksheets("Sheet1").Cells(Worksheets("Sheet1").Rows.Count, 1).End(xlUp).Row)
i = 2
Do While i <= myRange.Rows.Count
     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
  i = i + i
Loop

在Excel VBA中设置范围以省略第一行

2 个答案: