Concatenate multiple ranges using vba

问题:

I am hoping someone can help me with my problem. Basically, I have a number of ranges which I need to concatenate independently and put the values of the concatenated ranges into different cells. For example I want to: concatenate values in Range A1:A10 and put the result in F1 then I want to concatenate the Range B1:B10 and put the result in F2 then I want to concatenate the Range C1:C10 and put the result in F3 etc

I have tried to use following macro. However I get stuck; what the macro seems to be doing is concatenating range A1:A10 and then putting the results into F1 (which is what I want). However it also stores the information from the first concatenation into memory so that when it does the next concatenation, in cell F2 I get the concatenated results of F1 and F2 joined.

I have tried searching lots of forums, but since this is a code I made myself I can't find a solution, I am sure this is a common problem and that I am doing something wrong possibly not setting the variable correctly.

Thanks in advance for your help,

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 

回答1:

Here is my ConcatenateRange. It allows you to add a seperator if you please. It is optimized to handle large ranges since it works by dumping the data in a variant array and working with it within VBA.

You would use it like this:

=ConcatenateRange(A1:A10) 

The 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 

回答2:

... I would do this very differently... Why not create a function along the lines of:

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 

And then just, for example, set F1 = ConcatMe(A1:A10) or, then write code to assign the function to the cells you want...

Or, as @KazJaw mentioned in his comment, just set x="" before re-looping.

Hope this helps

回答3:

took me several minutes to notice this answer was under comments :p

回答4:

it is similar to the idea posted here already. However, I use a for each loop instead of an array setup with nested for loops.

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 

This, I suppose would be faster than the array set up, as a new array is not created each time this function runs.

回答5:

Thanks for everything guys, for my purpose I have modified your suggestions and amended my code as it didn't quite fit into a neat function as I needed it to be more dynamic. See my code below. It does exactly what I need.

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, 

回答6:

@Issun's solution doesn't accept output from a worksheet array formula as the argument for the 'cell_range' parameter. But a slight modification to @Issun's code fixes this. I also added a check that ignores each cell whose value is FALSE.

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 

For example:

A       B       (

Enter into cell C1 the formula below and press CTRL+ENTER to store the formula as an array formula:

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

回答7:

I was looking further to see if there is a better way of writing concatenate function and found this. It seems that we all have the same working principle for the function. So its ok.

But my function is different that it can take multiple parameters, in combination of ranges, texts and numbers.

I assume that a delimiter is mandatory, so if i don't need it i just put "" as the last parameter).

I also assume that blank cells are not to be skipped. That's the reason why i want the function to take multiple parameters, so i can easily omit those that that i don't want in the concatenation.

Example of use:

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

You can also use together text and number among the parameters:

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

I'd love to hear any comments or suggestions where it can be improved.

Here is the 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 

回答8:

Its very simple brother, Look out of the Excel. No need for all cumbersome formula or VBA.

Just copy all the cells that you need to concatenate and paste it in the notepad. Now just select the space between the lines/columns (it's a TAB space actually) and find and replace it.. Done.. All cells are concatenated. Now just copy and paste it in the column and just verify.. Thats it :) Enjoy.

I suggest you to use Notepad++ for this :) Koodos

Vimarsh Ph. D. Plant Biotech. /

文章来源: Concatenate multiple ranges using vba