Excel VBA阵列列表

Question

我在VBA蹒跚学步

我有一个很大的范围,这可能超过1000个文本值(这可能会下降A1),我试图将所有值与引号和逗号连接到一个单元格(C1),我知道转置公式,但我是不确定我的vba数组会将其识别为列表.

我渴望我的数组公式将c1识别为列表,以便执行我的操作.

我真的很想保持干净,不要使用连接并拖下各种公式.

我遇到过这个,但这并没有将所有值都粘贴到一个单元格中.

Sub transpose()
Dim rng As Range
Dim ws As Worksheet
Dim last As Range

Set ws = ActiveSheet   
Set last = ws.Cells(Rows.Count, "A").End(xlUp)
Set rng = ws.Range("A1", last)

For Each cell In rng
    Dim hold As String
    hold = """"
    hold = hold + cell.Value
    hold = hold + """" + ", "
    cell.Value = hold
Next cell

rng.Copy
ActiveWorkbook.Sheets(2).Range("A1").PasteSpecial transpose:=True
End Sub

代码由ryan E完成

如果有人可以在阵列的收集清单上建议任何作弊,这将是伟大的.除了在Excel中使用宏工具

例.

A1 = company1 A2 = company2等

解

C1将在一个单元格中显示"company1","company2",...."company10000"

Answer 1

您可以使用Join()和Transpose().

例如:

Sub transpose()

    Dim rng As Range
    Dim ws As Worksheet
    Dim last As Range

    Set ws = ActiveSheet

    Set last = ws.Cells(Rows.Count, "A").End(xlUp)
    Set rng = ws.Range(ws.Range("A1"), last)

    ws.Range("B1").Value = """" & Join(Application.Transpose(rng.Value), """,""") & """"

End Sub

编辑:现在我看到你真正想做的事情(创建一个要传递的工作表名称数组Sheets.Copy())这里有一种方法......

添加一个名为(例如)"Groups"的工作表来保存要复制的各种工作表列表:

组名在第1行,每个名称下面都有一个工作表列表.

然后使用此代码:

'to demo the "CopySheets()" sub...
Sub Tester()

    CopySheets "Group2" 'copy all sheets in Group2

End Sub


'Create of copy for all sheets under "GroupName" header...
Sub CopySheets(GroupName As String)

    Dim rng As Range, arr
    Dim ws As Worksheet
    Dim f As Range

    Set ws = ThisWorkbook.Sheets("Groups") '<< has lists of sheet names

    'find the header for the group to be copied
    Set f = ws.Rows(1).Find(GroupName, lookat:=xlWhole)

    If Not f Is Nothing Then
        'found the header, so create an array of the sheet names
        Set rng = ws.Range(f.Offset(1, 0), ws.Cells(ws.Rows.Count, f.Column).End(xlUp))
        arr = Application.transpose(rng.Value)
        'use the array in the sheets Copy method
        ThisWorkbook.Sheets(arr).Copy

    Else
        'alert if you tried to copy a non-existent group
        MsgBox "Sheet group '" & GroupName & "' was not found!"
    End If

End Sub