Excel 使用vba连接多个范围

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

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

下面的宏连接范围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

---

。。。我会做得非常不同。。。为什么不按照以下内容创建函数：

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

然后，例如，设置F1=

ConcatMe（A1:A10）

或者，然后编写代码将函数分配给所需的单元格

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

x=“

”

---

希望这有帮助，这是我的建议。如果您愿意，它允许您添加一个分隔符。它经过优化，可以处理大范围的数据，因为它的工作原理是将数据转储到变量数组中，并在VBA中使用它

您可以这样使用它：

=ConcatenateRange(A1:A10)

守则：

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

函数连接符（ByVal单元格范围作为范围_
可选的ByVal分隔符（作为字符串）作为字符串
将新闻字符串变暗为字符串
作为变体的暗射线
我和我一样长，我和我一样长
X射线=单元格\范围值
对于i=1到UBound（1）
对于j=1到uBond（2）
如果Len（ray（i，j））为0，那么
newString=newString&（分隔符和分隔符（i，j））
如果结束
下一个
下一个
如果Len（newString）为0，则
newString=Right$（newString，（Len（newString）-Len（分隔符）））
如果结束
concatenaterage=newString
端函数

谢谢大家，出于我的目的，我修改了你们的建议并修改了我的代码，因为它不太适合整洁的函数，因为我需要它更具动态性。请参阅下面的代码。这正是我需要的

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

Sub-concatenate（）
将x作为字符串
朦胧如弦
对于Q=1到10'这提供了一个列引用来连接-Outer For语句
对于T=1到10'这提供了一个行引用来连接-Inner For语句
对于单元（T，Q）中的每个单元，“”提供行和列引用
如果Cell.Value=“”则转到第1行“这会告诉宏继续，直到到达空白单元格为止
x=x&Cell.Value&“，”这提供了连接的单元格值和逗号分隔符
下一步是循环范围
下一个T'是内部循环，它动态地更改要循环的行数，直到到达空白单元格为止
第1行：
如果要连接的列较少（最多10列），则“On Error GoTo Terminate”终止
ActiveCell.Value=Mid（x，1，Len（x）-1）“这基本上从最后一个连接的单元格中删除了最后一个逗号，例如，你可能会得到一个范围为2,3,4的逗号，这与这里已经发布的想法类似。但是，我使用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

我认为这比数组设置要快，因为每次运行此函数时都不会创建新数组。
它的兄弟非常简单，请查看Excel。不需要所有繁琐的公式或VBA

只需复制所有需要连接的单元格并将其粘贴到记事本中即可。现在只需选择行/列之间的空间（实际上是一个选项卡空间），然后查找并替换它。。完成。。所有单元格都是串联的。现在只需复制并粘贴到列中，然后验证。。就这样：）享受吧

我建议您使用记事本+）来完成以下操作：）Koodos

Vimarsh
植物生物技术博士。
/
在下一个m之前插入简单语句：x=“”–KazimierzJawor 2013年4月8日20:43

我花了几分钟才注意到这个答案在评论中：p
@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

我在进一步研究是否有更好的方法来编写连接函数，并发现了这个问题。似乎我们都有相同的功能工作原理。所以没关系

但我的函数不同，它可以接受多个参数，包括范围、文本和数字

我假设分隔符是必需的，所以如果我不需要它，我就把“”作为最后一个参数）

我还假设不跳过空白单元格。这就是我希望函数采用多个参数的原因，因此我可以很容易地忽略在串联中不需要的参数

使用示例：

=JoinText（A1:D2，F1:I2，K1:L1，“；”）

您还可以在参数中同时使用文本和数字：

=JoinText（A1:D2123、F1:I2、K1:L1，“PQR”、“；”）

我很想听到任何可以改进的意见或建议

这是代码

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

函数
concatenaterage
连接范围内的所有单元格（如果它们不是空的且为空的“”字符串）

函数连接符（cellRange作为范围，可选分隔符作为字符串）作为字符串
尺寸单元作为范围，结构作为字符串
conStr=“”
如果是分隔符“”，则
对于cellRange中的每个cel
如果VarType（cel）vbEmpty且Trim（cel）“，则conStr=conStr&cel&Delimiter
下一个
concatenaterage=Left（conStr，Len（conStr）-Len（分隔符））
其他的
对于cellRange中的每个cel
如果VarType（cel）vbEmpty和Trim（cel）”，则conStr=conStr&cel
下一个
concatenaterage=conStr
如果结束
端函数
就在
下一个m
之前插入简单语句：
x=”“
哦，你这个天才！我在这上面浪费了一整天！非常感谢。非常感谢。非常感谢。非常感谢。感谢
{=ConcatenateRange(IF(B3:B6=1,A3:A6),CHAR(10))}

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

  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