繁体   English   中英

将范围设置为从宏的第2行开始

[英]Set Range to Start at Row 2 in a Macro

此宏将活动工作表中的所有列组合在一起,并将它们追加到工作表中名为Mainlist的新列中。

我面临的问题是此宏将标题(列名)组合到附加列中。 我需要修复此代码,以便从第2行开始复制。

我是VBA的新手。 请帮忙。

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

LBound() + 1开始循环,如下所示:

For lLoop1 = LBound(arr, 1) + 1 To UBound(arr, 1)
  For lLoop2 = LBound(arr, 2) + 1 To UBound(arr, 2)

暂无
暂无

声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM