Utwórz ciąg rozdzielany przecinkami

Question

Chcę zbudować ciąg rozdzielany przecinkami z zakresu A1:A400.

Jaki jest najlepszy sposób na zrobienie tego? Czy powinienem używać pętli For?

Answer 1

najbardziej leniwym sposobem jest

s = join(Application.WorksheetFunction.Transpose([a1:a400]), ",") 

To działa, ponieważ .Value własnością zakresie wielokomórkowej zwraca 2D tablicę, a Join spodziewa 1D tablicę, a Transpose stara się być zbyt pomocny, więc po wykryciu 2D tablica z jedną kolumną przekształca ją w tablicę 1D.

W produkcji zaleca się stosowanie co najmniej trochę mniej opcji leniwy,

s = join(Application.WorksheetFunction.Transpose(Worksheets(someIndex).Range("A1:A400").Value), ",") 

inaczej aktywny arkusz zawsze będzie używany.

Answer 2

Możesz użyć funkcji StringConcat stworzonej przez Chipa Pearsona. Proszę zapoznać się z poniższego linku :)

Wątek: String Powiązanie

link: http://www.cpearson.com/Excel/StringConcatenation.aspx

cytat z linku w przypadku łącza kiedykolwiek umiera

tę stronę opisuje funkcję VBA, której można użyć do łączenia wartości ciągu w formule tablicowej.

Funkcja StringConcat

W celu przezwyciężenia tych braków funkcji łączenia, konieczne jest, aby zbudować własną funkcję napisane w VBA, które rozwiązują problemy złączyć. Reszta tej strony opisuje taką funkcję o nazwie StringConcat. Ta funkcja eliminuje wszystkie braki CONCATENATE. Może być używany do łączenia pojedynczych wartości ciągów, wartości jednego lub więcej zakresów arkusza, literalnych tablic i wyników działania formuły tablicowej.

Deklaracja funkcją StringConcat jest następujący:

Funkcja StringConcat (SEP jako ciąg, ParamArray args()) As String

Parametr września jest znak lub znaki, które oddzielają łańcuchy są łączone. Może to być 0 lub więcej znaków. Parametr Sep jest wymagany. Jeśli nie chcesz żadnych separatorów w ciągu wynikowym, użyj pustego ciągu znaków dla wartości Sep. Wartość Sep pojawia się między poszczególnymi połączonymi łańcuchami, ale nie pojawia się na początku ani końcu ciągu wynikowego. Parametr ParamArray Args to wartości szeregowe, które należy łączyć. Każdy element w ParamArray może być jednym z następujących:

Dosłowny ciąg znaków, taki jak "A" Zakres komórek, określony przez adres lub nazwę zakresu. Gdy elementy dwuwymiarowego zakresu są łączone, kolejność konkatenacji jest w jednym rzędzie, a następnie w dół do następnego wiersza. Dosłowna tablica.Na przykład, { "A", "B", "C"} lub { "A", "B", "C"}

Funkcją

Function StringConcat(Sep As String, ParamArray Args()) As Variant 
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 
' StringConcat 
' By Chip Pearson, chip@cpearson.com, www.cpearson.com 
'     www.cpearson.com/Excel/stringconcatenation.aspx 
' This function concatenates all the elements in the Args array, 
' delimited by the Sep character, into a single string. This function 
' can be used in an array formula. There is a VBA imposed limit that 
' a string in a passed in array (e.g., calling this function from 
' an array formula in a worksheet cell) must be less than 256 characters. 
' See the comments at STRING TOO LONG HANDLING for details. 
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 
Dim S As String 
Dim N As Long 
Dim M As Long 
Dim R As Range 
Dim NumDims As Long 
Dim LB As Long 
Dim IsArrayAlloc As Boolean 

''''''''''''''''''''''''''''''''''''''''''' 
' If no parameters were passed in, return 
' vbNullString. 
''''''''''''''''''''''''''''''''''''''''''' 
If UBound(Args) - LBound(Args) + 1 = 0 Then 
    StringConcat = vbNullString 
    Exit Function 
End If 

For N = LBound(Args) To UBound(Args) 
    '''''''''''''''''''''''''''''''''''''''''''''''' 
    ' Loop through the Args 
    '''''''''''''''''''''''''''''''''''''''''''''''' 
    If IsObject(Args(N)) = True Then 
     ''''''''''''''''''''''''''''''''''''' 
     ' OBJECT 
     ' If we have an object, ensure it 
     ' it a Range. The Range object 
     ' is the only type of object we'll 
     ' work with. Anything else causes 
     ' a #VALUE error. 
     '''''''''''''''''''''''''''''''''''' 
     If TypeOf Args(N) Is Excel.Range Then 
      ''''''''''''''''''''''''''''''''''''''''' 
      ' If it is a Range, loop through the 
      ' cells and create append the elements 
      ' to the string S. 
      ''''''''''''''''''''''''''''''''''''''''' 
      For Each R In Args(N).Cells 
       If Len(R.Text) > 0 Then 
        S = S & R.Text & Sep 
       End If 
      Next R 
     Else 
      ''''''''''''''''''''''''''''''''' 
      ' Unsupported object type. Return 
      ' a #VALUE error. 
      ''''''''''''''''''''''''''''''''' 
      StringConcat = CVErr(xlErrValue) 
      Exit Function 
     End If 

    ElseIf IsArray(Args(N)) = True Then 
     ''''''''''''''''''''''''''''''''''''' 
     ' ARRAY 
     ' If Args(N) is an array, ensure it 
     ' is an allocated array. 
     ''''''''''''''''''''''''''''''''''''' 
     IsArrayAlloc = (Not IsError(LBound(Args(N))) And _ 
      (LBound(Args(N)) <= UBound(Args(N)))) 
     If IsArrayAlloc = True Then 
      '''''''''''''''''''''''''''''''''''' 
      ' The array is allocated. Determine 
      ' the number of dimensions of the 
      ' array. 
      ''''''''''''''''''''''''''''''''''''' 
      NumDims = 1 
      On Error Resume Next 
      Err.Clear 
      NumDims = 1 
      Do Until Err.Number <> 0 
       LB = LBound(Args(N), NumDims) 
       If Err.Number = 0 Then 
        NumDims = NumDims + 1 
       Else 
        NumDims = NumDims - 1 
       End If 
      Loop 
      On Error GoTo 0 
      Err.Clear 
      '''''''''''''''''''''''''''''''''' 
      ' The array must have either 
      ' one or two dimensions. Greater 
      ' that two caues a #VALUE error. 
      '''''''''''''''''''''''''''''''''' 
      If NumDims > 2 Then 
       StringConcat = CVErr(xlErrValue) 
       Exit Function 
      End If 
      If NumDims = 1 Then 
       For M = LBound(Args(N)) To UBound(Args(N)) 
        If Args(N)(M) <> vbNullString Then 
         S = S & Args(N)(M) & Sep 
        End If 
       Next M 

      Else 
       '''''''''''''''''''''''''''''''''''''''''''''''' 
       ' STRING TOO LONG HANDLING 
       ' Here, the error handler must be set to either 
       ' On Error GoTo ContinueLoop 
       ' or 
       ' On Error GoTo ErrH 
       ' If you use ErrH, then any error, including 
       ' a string too long error, will cause the function 
       ' to return #VALUE and quit. If you use ContinueLoop, 
       ' the problematic value is ignored and not included 
       ' in the result, and the result is the concatenation 
       ' of all non-error values in the input. This code is 
       ' used in the case that an input string is longer than 
       ' 255 characters. 
       '''''''''''''''''''''''''''''''''''''''''''''''' 
       On Error GoTo ContinueLoop 
       'On Error GoTo ErrH 
       Err.Clear 
       For M = LBound(Args(N), 1) To UBound(Args(N), 1) 
        If Args(N)(M, 1) <> vbNullString Then 
         S = S & Args(N)(M, 1) & Sep 
        End If 
       Next M 
       Err.Clear 
       M = LBound(Args(N), 2) 
       If Err.Number = 0 Then 
        For M = LBound(Args(N), 2) To UBound(Args(N), 2) 
         If Args(N)(M, 2) <> vbNullString Then 
          S = S & Args(N)(M, 2) & Sep 
         End If 
        Next M 
       End If 
       On Error GoTo ErrH: 
      End If 
     Else 
      If Args(N) <> vbNullString Then 
       S = S & Args(N) & Sep 
      End If 
     End If 
     Else 
     On Error Resume Next 
     If Args(N) <> vbNullString Then 
      S = S & Args(N) & Sep 
     End If 
     On Error GoTo 0 
    End If 
ContinueLoop: 
Next N 

''''''''''''''''''''''''''''' 
' Remove the trailing Sep 
''''''''''''''''''''''''''''' 
If Len(Sep) > 0 Then 
    If Len(S) > 0 Then 
     S = Left(S, Len(S) - Len(Sep)) 
    End If 
End If 

StringConcat = S 
''''''''''''''''''''''''''''' 
' Success. Get out. 
''''''''''''''''''''''''''''' 
Exit Function 
ErrH: 
''''''''''''''''''''''''''''' 
' Error. Return #VALUE 
''''''''''''''''''''''''''''' 
StringConcat = CVErr(xlErrValue) 
End Function 

Answer 3

ja uważa @ GSerg na odpowiedź jako ostateczną odpowiedź na twoje pytanie.

Dla kompletności - i zająć kilka ograniczeń w innych odpowiedzi - Proponuję, żeby użyć funkcji „Dołącz”, który wspiera 2-wymiarowej macierzy:

 
s = Join2d(Worksheets(someIndex).Range("A1:A400").Value) 

Chodzi o to, że Właściwością wartości zakresu (pod warunkiem, że nie jest to pojedyncza komórka) jest zawsze tablica 2-wymiarowa.

Zauważ, że ogranicznik wiersza w poniższej funkcji Join2d występuje tylko wtedy, gdy istnieją ograniczenia w liczbie wierszy (liczba mnoga): nie zobaczysz go w połączonym łańcuchu z zakresu pojedynczego rzędu.

Join2d: ± 2-wymiarowe funkcji Dołącz VBA zoptymalizowane ciąg obsługi

kodowania Uwagi:

1. to Join funkcja nie cierpi z ograniczenia 255 zwęglonej, która dotyka większość (jeśli nie wszystkie) natywnych funkcji Concatenate w Excelu, a powyższy przykład kodu Range.Value przekaże w całości dane z komórek zawierających dłuższe łańcuchy.
2. Jest to silnie zoptymalizowane: używamy konkatenacji ciągów tak mało, jak to tylko możliwe, ponieważ natywne wiązania VBA są powolne i stają się coraz wolniejsze w miarę łączenia dłuższego łańcucha.

 
    Public Function Join2d(ByRef InputArray As Variant, _ 
          Optional RowDelimiter As String = vbCr, _ 
          Optional FieldDelimiter = vbTab,_ 
          Optional SkipBlankRows As Boolean = False) As String
 

' Join up a 2-dimensional array into a string. Works like VBA.Strings.Join, for a 2-dimensional array. 
' Note that the default delimiters are those inserted into the string returned by ADODB.Recordset.GetString 
On Error Resume Next 

' Coding note: we're not doing any string-handling in VBA.Strings - allocating, deallocating and (especially!) concatenating are SLOW. 
' We're using the VBA Join & Split functions ONLY. The VBA Join, Split, & Replace functions are linked directly to fast (by VBA standards) 
' functions in the native Windows code. Feel free to optimise further by declaring and using the Kernel string functions if you want to. 

' **** THIS CODE IS IN THE PUBLIC DOMAIN **** Nigel Heffernan Excellerando.Blogspot.com 

Dim i As Long 
Dim j As Long 
Dim i_lBound As Long 
Dim i_uBound As Long 
Dim j_lBound As Long 
Dim j_uBound As Long 
Dim arrTemp1() As String 
Dim arrTemp2() As String 
Dim strBlankRow As String 

i_lBound = LBound(InputArray, 1) 
i_uBound = UBound(InputArray, 1) 
j_lBound = LBound(InputArray, 2) 
j_uBound = UBound(InputArray, 2) 

ReDim arrTemp1(i_lBound To i_uBound) 
ReDim arrTemp2(j_lBound To j_uBound) 

For i = i_lBound To i_uBound 

    For j = j_lBound To j_uBound 
     arrTemp2(j) = InputArray(i, j) 
    Next j 
    arrTemp1(i) = Join(arrTemp2, FieldDelimiter) 
Next i 

If SkipBlankRows Then 
    If Len(FieldDelimiter) = 1 Then 
     strBlankRow = String(j_uBound - j_lBound, FieldDelimiter) 
    Else 
     For j = j_lBound To j_uBound 
      strBlankRow = strBlankRow & FieldDelimiter 
     Next j 
    End If 

    Join2d = Replace(Join(arrTemp1, RowDelimiter), strBlankRow & RowDelimiter, "") 
    i = Len(strBlankRow & RowDelimiter) 

    If Left(Join2d, i) = strBlankRow & RowDelimiter Then 
     Mid$(Join2d, 1, i) = "" 
    End If 
Else 
    Join2d = Join(arrTemp1, RowDelimiter) 
End If 
Erase arrTemp1 
End Function 
 

Dla kompletności tutaj odpowiedni 2-D funkcji podziału:

Split2d: ± 2-wymiarowe funkcji podziału VBA jest zoptymalizowana łańcuch obsługi

 

Public Function Split2d(ByRef strInput As String, _ 
         Optional RowDelimiter As String = vbCr, _ 
         Optional FieldDelimiter = vbTab, _ 
         Optional CoerceLowerBound As Long = 0) As Variant 

' Split up a string into a 2-dimensional array. Works like VBA.Strings.Split, for a 2-dimensional array. 
' Check your lower bounds on return: never assume that any array in VBA is zero-based, even if you've set Option Base 0 
' If in doubt, coerce the lower bounds to 0 or 1 by setting CoerceLowerBound 
' Note that the default delimiters are those inserted into the string returned by ADODB.Recordset.GetString 
On Error Resume Next 

' Coding note: we're not doing any string-handling in VBA.Strings - allocating, deallocating and (especially!) concatenating are SLOW. 
' We're using the VBA Join & Split functions ONLY. The VBA Join, Split, & Replace functions are linked directly to fast (by VBA standards) 
' functions in the native Windows code. Feel free to optimise further by declaring and using the Kernel string functions if you want to. 


' **** THIS CODE IS IN THE PUBLIC DOMAIN **** Nigel Heffernan Excellerando.Blogspot.com 

Dim i As Long 
Dim j As Long 
Dim i_n As Long 
Dim j_n As Long 
Dim i_lBound As Long 
Dim i_uBound As Long 
Dim j_lBound As Long 
Dim j_uBound As Long 
Dim arrTemp1 As Variant 
Dim arrTemp2 As Variant 

arrTemp1 = Split(strInput, RowDelimiter) 

i_lBound = LBound(arrTemp1) 
i_uBound = UBound(arrTemp1) 

If VBA.LenB(arrTemp1(i_uBound)) <= 0 Then ' clip out empty last row: common artifact data loaded from files with a terminating row delimiter 
    i_uBound = i_uBound - 1 
End If 

i = i_lBound 
arrTemp2 = Split(arrTemp1(i), FieldDelimiter) 

j_lBound = LBound(arrTemp2) 
j_uBound = UBound(arrTemp2) 

If VBA.LenB(arrTemp2(j_uBound)) <= 0 Then ' ! potential error: first row with an empty last field... 
    j_uBound = j_uBound - 1 
End If 

i_n = CoerceLowerBound - i_lBound 
j_n = CoerceLowerBound - j_lBound 

ReDim arrData(i_lBound + i_n To i_uBound + i_n, j_lBound + j_n To j_uBound + j_n) 

' As we've got the first row already... populate it here, and start the main loop from lbound+1 

For j = j_lBound To j_uBound 
    arrData(i_lBound + i_n, j + j_n) = arrTemp2(j) 
Next j 

For i = i_lBound + 1 To i_uBound Step 1 
    arrTemp2 = Split(arrTemp1(i), FieldDelimiter) 
    For j = j_lBound To j_uBound Step 1  
     arrData(i + i_n, j + j_n) = arrTemp2(j)  
    Next j  
    Erase arrTemp2 
Next i 

Erase arrTemp1 

Application.StatusBar = False 

Split2d = arrData 
End Function 
 

Podziel się i cieszyć ... I uważaj na niechcianych podziały wiersza w kodzie, wstawionych przez przeglądarkę (lub przez pomocnych funkcji formatowania StackOverflow'S)