Verketten Sie mehrere Bereiche mit vba

Question

Ich hoffe, jemand kann mir mit meinem Problem helfen. Grundsätzlich habe ich eine Reihe von Bereichen, die ich unabhängig verketten muss und die Werte der verketteten Bereiche in verschiedene Zellen setzen. Zum Beispiel möchte ich: Werte im Bereich A1: A10 verketten und das Ergebnis in F1 setzen dann möchte ich den Bereich B1 verketten: B10 und das Ergebnis in F2 setzen dann möchte ich den Bereich C1 verketten: C10 und setzen das Ergebnis in F3 usw.

Ich habe versucht, folgenden Makro zu verwenden. Aber ich bleibe stecken. Was das Makro zu tun scheint, ist die Verkettung von Bereich A1: A10 und dann das Einfügen der Ergebnisse in F1 (was ich will). Es speichert jedoch auch die Information von der ersten Verkettung in den Speicher, so dass, wenn es die nächste Verkettung ausführt, in Zelle F2 die verketteten Ergebnisse von F1 und F2 verbunden werden.

Ich habe versucht, viele Foren zu suchen, aber da dies ein Code ist, den ich selbst gemacht habe, kann ich keine Lösung finden, ich bin mir sicher, dass dies ein häufiges Problem ist und ich etwas falsch mache, möglicherweise die Variable nicht richtig setzen .

Vielen Dank im Voraus für Ihre Hilfe,

Sub concatenate() 

    Dim x As String 
    Dim Y As String 

For m = 2 To 5 

    Y = Worksheets("Variables").Cells(m, 5).Value 

'Above essentially has the range information e.g. a1:a10 in sheet variables 

For Each Cell In Range("" & Y & "") 'i.e. range A1:A10 
    If Cell.Value = "" Then GoTo Line1 'this tells the macro to continue until a blank cell is reached 
    x = x & Cell.Value & "," 'this provides the concatenated cell value 
Next 

Line1: 

ActiveCell.Value = x 

ActiveCell.Offset(1, 0).Select 

Next m 

End Sub 

Answer 1

... Ich würde dies tun, ganz anders ... Warum nicht eine Funktion entlang der Linien erstellen:

Function ConcatMe(Rng As Range) As String 

Dim cl As Range 

    ConcatMe = "" 

    For Each cl In Rng 
     ConcatMe = ConcatMe & cl.Text 
    Next cl 

End Function 

Und dann nur B. F1 = ConcatMe(A1:A10) oder schreiben Sie dann Code, um die Funktion den gewünschten Zellen zuzuweisen ...

Oder, wie @KazJaw in seinem Kommentar erwähnt, setzen Sie einfach x="" vor dem erneuten Looping.

this helps

Answer 2

Hier ist mein ConcatenateRange. Sie können einen Separator hinzufügen, wenn Sie möchten. Es ist für die Verarbeitung großer Bereiche optimiert, da es die Daten in einem Varianten-Array ablegt und damit in VBA arbeitet.

Sie es wie folgt verwenden würde:

=ConcatenateRange(A1:A10) 

Der Code:

Function ConcatenateRange(ByVal cell_range As range, _ 
        Optional ByVal seperator As String) As String 

Dim cell As range 
Dim newString As String 
Dim cellArray As Variant 
Dim i As Long, j As Long 

cellArray = cell_range.Value 

For i = 1 To UBound(cellArray, 1) 
    For j = 1 To UBound(cellArray, 2) 
     If Len(cellArray(i, j)) <> 0 Then 
      newString = newString & (seperator & cellArray(i, j)) 
     End If 
    Next 
Next 

If Len(newString) <> 0 Then 
    newString = Right$(newString, (Len(newString) - Len(seperator))) 
End If 

ConcatenateRange = newString 

End Function 

Answer 3

Danke für alles Jungs, für meine Zwecke Ich habe Ihre Vorschläge modifiziert und geändert meinen Code, da es nicht tat passte ziemlich gut in eine ordentliche Funktion, da ich es dynamischer brauchte. Siehe meinen Code unten. Es macht genau das, was ich brauche.

Sub concatenate() 

Dim x As String 
Dim Y As String 

For Q = 1 To 10 'This provides a column reference to concatenate - Outer For statement 
For T = 1 To 10 'This provides a rows reference to concatenate - Inner for statement 

For Each Cell In Cells(T, Q) 'provides rows and column reference 
If Cell.Value = "" Then GoTo Line1 'this tells the macro to continue until a blank cell is reached 
x = x & Cell.Value & "," 'This provides the concatenated cell value and comma separator 
Next ' this loops the range 

Next T 'This is the inner loop which dynamically changes the number of rows to loop until a blank cell is reached 

Line1: 
On Error GoTo Terminate 'Terminates if there are less columns (max 10) to concatenate 

ActiveCell.Value = Mid(x, 1, Len(x) - 1) 'This basically removes the last comma from the last concatenated cell e.g. you might get for a range 2,3,4, << this formula removes the last comma to 
'give 2,3,4 

ActiveCell.Offset(1, 0).Select 'Once the concatenated result is pasted into the cell this moves down to the next cell, e.g. from F1 to F2 

x = "" 'The all important, clears x value after finishing concatenation for a range before moving on to another column and range 


Next Q 'After one range is done the second column loop kicks in to tell the macro to move to the next column and begin concatenation range again 

Terminate: 'error handler 
End Sub 

Answer 4

ist es ähnlich der Idee hier bereits gepostet. Allerdings verwende ich für jede Schleife eine anstelle einer Array-Konfiguration mit verschachtelten for-Schleifen.

Function ConcRange(ByRef myRange As Range, Optional ByVal Seperator As String = "") 

ConcRange = vbNullString 

Dim rngCell As Range 

For Each rngCell In myRange 
    If ConcRange = vbNullString Then 
     If Not rngCell.Value = vbNullString Then 
      ConcRange = CStr(rngCell.Value) 
     End If 
    Else 
     If Not rngCell.Value = vbNullString Then 
      ConcRange = ConcRange & Seperator & CStr(rngCell.Value) 
     End If 
    End If 
Next rngCell 


End Function 

Dies, glaube ich wäre schneller als das Array einzurichten, als ein neues Array nicht jedes Mal diese Funktion läuft erstellt wird.

Answer 5

Sein sehr einfacher Bruder, Schauen Sie aus dem Excel. Keine Notwendigkeit für alle umständliche Formel oder VBA.

Kopieren Sie einfach alle Zellen, die Sie verketten müssen, und fügen Sie sie in den Editor ein.Jetzt wählen Sie einfach den Abstand zwischen den Zeilen/Spalten (es ist tatsächlich ein TAB-Leerzeichen) und suchen und ersetzen Sie es .. Fertig .. Alle Zellen sind verkettet. Jetzt kopiere es einfach und füge es in die Spalte ein und verifiziere einfach ... Das ist es :) Viel Spaß.

Ich schlage vor, Sie Notepad ++ verwenden für diese :) Koodos

Vimarsh Ph. D. Pflanzen Biotech. /

Answer 6

Kurz vor Next m Einsatz einfache Aussage: x = "" - KazimierzJawor 8. April '13 um 20:43 Uhr

hat mich mehrere Minuten, um diese Antwort zu bemerken war unter Kommentare: p

Answer 7

@ Issuns Lösung akzeptiert keine Ausgabe aus einer Worksheet-Array-Formel als Argument für den Parameter 'cell_range'. Aber eine leichte Änderung an @ Issuns Code behebt dies. Ich fügte auch eine Prüfung hinzu, die jede Zelle ignoriert, deren Wert FALSE ist.

Function ConcatenateRange(_ 
     ByVal cellArray As Variant, _ 
     Optional ByVal seperator As String _ 
      ) As String 

    Dim cell As Range 
    Dim newString As String 
    Dim i As Long, j As Long 

    For i = 1 To UBound(cellArray, 1) 
     For j = 1 To UBound(cellArray, 2) 
      If Len(cellArray(i, j)) <> 0 Then 
       If (cellArray(i, j) <> False) Then 
        newString = newString & (seperator & cellArray(i, j)) 
       End If 
      End If 
     Next 
    Next 

    If Len(newString) <> 0 Then 
     newString = Right$(newString, (Len(newString) - Len(seperator))) 
    End If 

    ConcatenateRange = newString 

End Function 

Zum Beispiel:

A  B  (<COL vROW) 
------ ------ ----------------- 
one  1   3 
two  1   4 
three 2   5 
four 2   6 

Geben Sie in der Zelle C1 die Formel unten und drücken Sie CTRL + ENTER, um die Formel als Matrixformel zu speichern:

{=ConcatenateRange(IF(B3:B6=1,A3:A6),CHAR(10))} 

Answer 8

Ich war auf der Suche weiter Sehen Sie, ob es eine bessere Möglichkeit gibt, die Verkettungsfunktion zu schreiben und diese gefunden zu haben. Es scheint, dass wir alle das gleiche Arbeitsprinzip für die Funktion haben. Also ist es in Ordnung.

Aber meine Funktion ist anders, dass es mehrere Parameter in Kombination von Bereichen, Texten und Zahlen annehmen kann.

Ich nehme an, dass ein Trennzeichen obligatorisch ist, also wenn ich es nicht brauche, gebe ich einfach "" als letzten Parameter ein.

Ich nehme auch an, dass leere Zellen nicht übersprungen werden sollen. Das ist der Grund, warum ich möchte, dass die Funktion mehrere Parameter nimmt, so kann ich leicht diejenigen weglassen, die ich nicht in der Verkettung will.

Beispiel:

=JoinText(A1:D2,F1:I2,K1:L1,";")

Sie können auch Text und Nummer unter den Parametern zusammen verwenden:

=JoinText(A1:D2,123,F1:I2,K1:L1,"PQR",";")

Ich würde gerne Kommentare oder Vorschläge hören, wo es Kann verbessert werden.

Hier ist der Code.

Public Function JoinText(ParamArray Parameters() As Variant) As String 
    Dim p As Integer, c As Integer, Delim As String 

    Delim = Parameters(UBound(Parameters)) 

    For p = 0 To UBound(Parameters) - 1 
     If TypeName(Parameters(p)) = "Range" Then 
      For c = 1 To Parameters(p).Count 
       JoinText = JoinText & Delim & Parameters(p)(c) 
      Next c 
     Else 
      JoinText = JoinText & Delim & Parameters(p) 
     End If 
    Next p 

    JoinText = Replace(JoinText, Delim, "", , 1, vbBinaryCompare) 

End Function