使用 vba 连接多个范围
Posted
技术标签:
【中文标题】使用 vba 连接多个范围【英文标题】：Concatenate multiple ranges using vba 【发布时间】：2013-03-31 01:56:48 【问题描述】：我有许多范围要独立连接，并将连接范围的值放入不同的单元格中。
我想： 连接范围 A1:A10 中的值并将结果放入 F1 然后连接 Range 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
【问题讨论】：
在Next m之前插入简单语句：x=""
哦，天才！我在这上面浪费了一整天！谢谢！谢谢！谢谢！谢谢！谢谢！谢谢！谢谢！谢谢！谢谢！谢谢！谢谢！谢谢！谢谢！
【参考方案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
【讨论】：
【参考方案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=""。
希望对你有帮助
【讨论】：
+ 1 我正要粘贴几乎类似的建议，但由于您发布了答案而不得不中止:) @SiddharthRout ...我的一些解决方案也发生了同样的情况...我想伟大的思想都一样:) 虽然有一个建议...Function ConcatenateRange(rng As Range, Sep As String) Sep 是分隔符 ;)
我确信有更简单的方法可以做到这一点，我不知道 x "" 实际上是做什么的？它以某种方式占用了最后一个循环或什么的内存？也不知道你可以像这样在 vba 中做一个函数。但是，因为我有 30/40 行，我认为我必须分别将 F1 设置为 F30，这就是为什么我想为下一个语句做一个整体，例如对于 m = 2 到 20。然后它会自动循环 20 次。我会玩这个。但是 x = "" 有效！【参考方案3】：
这与这里已经发布的想法相似。但是，我使用 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
我想这会比设置数组更快，因为每次运行此函数时都不会创建一个新数组。
【讨论】：
【参考方案4】：就在 Next m 之前插入简单语句：x="" – KazimierzJawor 2013 年 4 月 8 日 20:43
我花了几分钟才注意到这个答案在 cmets 下：p
【讨论】：
【参考方案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
【讨论】：
【参考方案6】：@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
例如：
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))
【讨论】：
【参考方案7】：我正在进一步寻找是否有更好的方法来编写连接函数并找到了这个。似乎我们都有相同的功能工作原理。所以没关系。
但我的函数不同，它可以接受多个参数，包括范围、文本和数字的组合。
我假设分隔符是强制性的，所以如果我不需要它，我只需将“”作为最后一个参数）。
我还假设不会跳过空白单元格。这就是我希望该函数采用多个参数的原因，因此我可以轻松地在连接中省略那些我不想要的参数。
使用示例：
=JoinText(A1:D2,F1:I2,K1:L1,";")
参数之间也可以同时使用文本和数字：
=JoinText(A1:D2,123,F1:I2,K1:L1,"PQR",";")
我很想听听任何可以改进的 cmets 或建议。
这是代码。
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】：函数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
【讨论】：
【参考方案9】：很简单的兄弟，看看Excel。不需要所有繁琐的公式或 VBA。
只需复制您需要连接的所有单元格并将其粘贴到记事本中。现在只需选择行/列之间的空间（实际上是 TAB 空间）并找到并替换它.. 完成.. 所有单元格都连接起来。现在只需将其复制并粘贴到列中，然后验证.. 就是这样:) 享受吧。
我建议您为此使用 Notepad++ :) Koodos
Vimarsh 植物生物技术博士。 /
【讨论】：
这不是一个好的答案。问题不在于如何避免表现出色。并且您建议安装另一个不必要的程序并选择选项卡空间 - 大多数普通用户甚至不理解以上是关于使用 vba 连接多个范围的主要内容，如果未能解决你的问题，请参考以下文章
Excel VBA - 搜索范围和连接的 SQL ADODB 记录集以在列中匹配写入结果集