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 

Код сделано Райаном E

Если кто-нибудь может подсказать читы на сбор список для массивов, которые были бы велики. За исключением использования инструмента Макро в excel

Пример.

A1 = Company1 A2 = Общества2 и т.д.

Решение

C1 будет отображаться в одной ячейке "company1", "Общества2", .... "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 

EDIT: теперь я вижу, что вы действительно хотите сделать (создать массив имен листов, чтобы перейти к Sheets.Copy()) вот один подход ...

Добавить лист с именем (например) «Группы», чтобы держать ваши различные списки листов для копирования:

Имена групп приведены в строке 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