2013-04-08 63 views
6

我希望有人可以帮我解决我的问题。基本上,我有一些范围,我需要独立连接并将连接范围的值放入不同的单元格中。例如,我想要: 在范围A1:A10中连接值并将结果放入F1 ,然后我想连接范围B1:B10并将结果放入F2 ,然后我想连接范围C1:C10并将在F3等结果使用vba连接多个范围

我试图使用下面的宏。但是我卡住了;宏看起来在做什么是连接范围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 
+1

就在'Next m'插入简单语句:'x =“”' – 2013-04-08 20:43:51

+1

哦,你天才!我浪费了整整一天的时间!谢谢!谢谢!谢谢!谢谢!谢谢!谢谢!谢谢!谢谢!谢谢!谢谢!谢谢!谢谢!谢谢! – user2259146 2013-04-08 20:53:48

回答

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=""重新循环之前。

希望这会有帮助

+0

+ 1我准备粘贴几乎类似的建议,但不得不放弃,因为你发布了一个答案:) – 2013-04-08 20:50:33

+0

@SiddharthRout ...我已经有过与你的一些解决方案相同的事情......我想伟大的思想都一样:) – 2013-04-08 20:54:00

+0

虽然有一个建议...'Function ConcatenateRange(rng As Range,Sep as String)'其中Sep是分隔符;) – 2013-04-08 20:54:31

7

这是我的ConcatenateRange。如果你愿意,它可以让你添加一个分隔符。它针对大范围进行了优化,因为它通过将数据转储到变体数组中并在VBA中使用它进行工作。

你会使用这样的:

=ConcatenateRange(A1:A10) 

代码:

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 
+0

这工作就像一个魅力!谢谢 – Asped 2016-02-12 13:07:58

0

感谢一切的家伙,我的目的,我已经修改了您的建议和修改我的代码,因为它不完全符合一个整洁的功能,因为我需要它更具活力。看到我的代码如下。它完全符合我的需求。

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 
0

它与此处发布的想法类似。但是,我使用每个循环代替嵌套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 

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

-3

其非常简单的兄弟,从Excel中注意。不需要所有繁琐的公式或VBA。

只需复制您需要连接并粘贴到记事本中的所有单元格即可。现在只需选择行/列之间的空间(实际上是一个TAB空间)并查找并替换它。完成..所有单元格都连接在一起。现在只需将其复制并粘贴到列中,然后验证就可以了。多数民众赞成它:)享受。

我建议你用记事本++这个:) Koodos

Vimarsh 博士植物生物技术。 /

+0

这是没有好的答案。问题不在于如何避免excel。你建议安装另一个不需要的程序,并选择一个标签空间 - 大多数普通用户甚至不理解 – Asped 2016-02-12 13:07:22

1

前右接下来的m插入简单的语句:X = “” - KazimierzJawor年04月08 '13 20:43时

我花了好几分钟注意到这个答案正在评论:p

0

@ 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))} 
0

我进一步期待看看是否有更好的写连接函数的方法,并找到了这个。看起来我们都有相同的功能原理。所以它确定。

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

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

我还假设空白单元格不会被跳过。这就是为什么我想要函数接受多个参数的原因,所以我可以轻松地忽略那些我不想在并置中使用的参数。使用

例子:

=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