使用 vba 连接多个范围

Concatenate multiple ranges using vba

提问by user2259146

I have a number of ranges to concatenate independently and put the values of the concatenated ranges into different cells.

我有许多范围可以独立连接，并将连接范围的值放入不同的单元格中。

I want to:
concatenate values in Range A1:A10 and put the result in F1
then concatenate the Range B1:B10 and put the result in F2
then concatenate the Range C1:C10 and put the result in F3 etc.

我想：
连接范围 A1:A10 中的值并将结果放入 F1
然后连接范围 B1:B10 并将结果放入 F2
然后连接范围 C1:C10 并将结果放入 F3 等。

The following macro concatenates range A1:A10 and then puts 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.

以下宏连接范围 A1:A10，然后将结果放入 F1（这是我想要的）。然而，它还将来自第一次连接的信息存储到内存中，以便在进行下一次连接时，在单元格 F2 中我得到 F1 和 F2 的连接结果。

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

回答by aevanko

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.

这是我的 ConcatenateRange。如果您愿意，它允许您添加分隔符。它经过优化以处理大范围，因为它通过将数据转储到变体数组中并在 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 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

回答by John Bustos

... 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...

然后只是，例如，设置 F1 =ConcatMe(A1:A10)或，然后编写代码将该功能分配给您想要的单元格...

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

或者，正如@KazJaw 在他的评论中提到的，只是x=""在重新循环之前设置。

Hope this helps

希望这可以帮助

回答by Jason K.

Right before Next m insert simple statement: x="" – KazimierzJawor Apr 8 '13 at 20:43

在 Next m 之前插入简单语句：x="" – KazimierzJawor 2013 年 4 月 8 日 20:43

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

我花了几分钟才注意到这个答案在评论中：p

回答by Ejaz Ahmed

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.

它类似于已经在这里发布的想法。但是，我使用 for each 循环而不是具有嵌套 for 循环的数组设置。

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.

我想这会比设置的数组更快，因为每次运行此函数时都不会创建新数组。

回答by Jim Fischer

@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.

@Issun 的解决方案不接受来自工作表数组公式的输出作为 'cell_range' 参数的参数。但是对@Issun 的代码稍作修改就解决了这个问题。我还添加了一个检查，忽略值为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       (<COL vROW)
------  ------  -----------------
one     1         3
two     1         4
three   2         5
four    2         6

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

在单元格 C1 中输入以下公式，然后按 CTRL+ENTER 将公式存储为数组公式：

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

回答by Rosetta

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,";")

=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",";")

=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

回答by SUNIL KUMAR

Function ConcatenateRangeto concatenate all cells in range if they are not empty and empty "" string.

函数ConcatenateRange连接范围内的所有单元格，如果它们不是空的并且是空的 "" 字符串。

  Function ConcatenateRange(cellRange As Range, Optional Delimiter As String) As String
    Dim cel As Range, conStr As String

    conStr = ""
    If Delimiter <> "" Then
      For Each cel In cellRange
        If VarType(cel) <> vbEmpty And Trim(cel) <> "" Then conStr = conStr & cel & Delimiter
      Next
      ConcatenateRange = Left(conStr, Len(conStr) - Len(Delimiter))
    Else
      For Each cel In cellRange
        If VarType(cel) <> vbEmpty And Trim(cel) <> "" Then conStr = conStr & cel
      Next
      ConcatenateRange = conStr
    End If
End Function

回答by user2259146

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, << 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

回答by user3544068

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

其很简单的兄弟，从Excel中看出来。不需要所有繁琐的公式或 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

我建议你为此使用 Notepad++ :) Koodos

Vimarsh Ph. D. Plant Biotech./

Vimarsh 博士。 植物生物技术。/