Question

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

我想：
连接范围A1中的值：A10并将结果放在F1
中然后连接范围B1：B10并将结果放入F2
然后连接Range 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

Answer 1

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

Answer 2

...我会以非常不同的方式做到这一点......为什么不按照以下方式创建一个函数：

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=""。

希望这有帮助

Answer 3

它类似于此处发布的想法。但是，我为每个循环使用a而不是使用嵌套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

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

Answer 4

在下一个之前插入简单陈述：x =＆＃34;＆＃34; - KazimierzJawor 4月8日13点20:43

花了几分钟时间注意到这个答案正在评论中：p

Answer 5

感谢所有人，为了我的目的，我修改了你的建议并修改了我的代码，因为它不太适合一个整洁的功能，因为我需要它更有活力。请参阅下面的代码。它完全符合我的需要。

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 6

@ Issun的解决方案不接受工作表数组公式的输出作为＆＃39; cell_range＆＃39;的参数。参数。但是对@ 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

例如：

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

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

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

Answer 7

我正在进一步研究是否有更好的编写连接函数的方法并找到了这个。似乎我们都有相同的功能工作原理。好吧。

但我的功能不同，它可以采用多个参数，结合范围，文本和数字。

我认为分隔符是强制性的，所以如果我不需要它，我只需将“”作为最后一个参数。）

我还假设不要跳过空白单元格。这就是为什么我希望函数采用多个参数的原因，所以我可以轻松省略那些在连接中我不想要的那些。

使用示例：

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

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

=JoinText(A1:D2,123,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

Answer 8

函数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

Answer 9

非常简单的兄弟，看看Excel。不需要所有繁琐的配方或VBA。

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

我建议您使用Notepad ++ :) Koodos

<强> Vimarsh Ph.D. Plant Biotech。 /

使用vba连接多个范围

9 个答案: