使用vba連接多個範圍

Question

我希望有人可以幫我解決我的問題。基本上，我有一些範圍，我需要獨立連接並將連接範圍的值放入不同的單元格中。例如，我想要： 在範圍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 

Answer 1

...我會做到這一點非常不同......爲什麼不創建的線沿線的一個功能：

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 2

這是我的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 

Answer 3

感謝一切的傢伙，我的目的，我已經修改了您的建議和修改我的代碼，因爲它不完全符合一個整潔的功能，因爲我需要它更具活力。看到我的代碼如下。它完全符合我的需求。

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 4

它與此處發佈的想法類似。但是，我使用每個循環代替嵌套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 5

其非常簡單的兄弟，從Excel中注意。不需要所有繁瑣的公式或VBA。

只需複製您需要連接並粘貼到記事本中的所有單元格即可。現在只需選擇行/列之間的空間（實際上是一個TAB空間）並查找並替換它。完成..所有單元格都連接在一起。現在只需將其複製並粘貼到列中，然後驗證就可以了。多數民衆贊成它:)享受。

我建議你用記事本++這個:) Koodos

Vimarsh 博士植物生物技術。 /

Answer 6

前右接下來的m插入簡單的語句：X = 「」 - KazimierzJawor年04月08 '13 20:43時

我花了好幾分鐘注意到這個答案正在評論：p

Answer 7

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

Answer 8

我進一步期待看看是否有更好的寫連接函數的方法，並找到了這個。看起來我們都有相同的功能原理。所以它確定。

但我的功能是不同的，它可以採用多個參數，結合範圍，文本和數字。

我認爲一個分隔符是強制性的，所以如果我不需要它，我只是把「」作爲最後一個參數）。

我還假設空白單元格不會被跳過。這就是爲什麼我想要函數接受多個參數的原因，所以我可以輕鬆地忽略那些我不想在並置中使用的參數。使用

例子：

=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