在每一行中合併單元格

我知道如何合併單元格，我知道如何合併列，並且我知道如何合併表格。然而，有什麼辦法可以將行中的所有單元格合併到多行中？因此，要進一步澄清，我在我的Excel工作表中三行如下：在每一行中合併單元格

First Name Middle Name Last Name 
John   James   Smith 
Sally   Anne   Lavery 
Tom   John   Doe

我需要能夠在每一行中合併這些細胞是這樣的：

Name 
John; James; Smith 
Sally; Anne; Lavery 
Tom; John; Doe

所以3行所有與一個細胞。我已經能夠找到爲1點的行做到這一點的方法，但如果我延長我的範圍是它們都合併到一個單元格，而不是3行：

Dim Rng As Range 
Dim WorkRng As Range 
Dim Sigh As String 
On Error Resume Next 
Set WorkRng = Application.Selection 
Set WorkRng = Range("A18:I19") 
Sigh = ";" 
xOut = "" 
Application.DisplayAlerts = False 
For Each Rng In WorkRng 
    xOut = xOut & Rng.Value & Sigh 
Next 
With WorkRng 
    .Merge 
    .Value = VBA.Left(xOut, VBA.Len(xOut) - 1) 
End With 
Application.DisplayAlerts = True

我使用Excel 2010中

來源

2015-08-25 Colm Donnelly

你需要按行通過你的選擇範圍的行工作：

Sub Test1() 

    MergeRowByRow Range("A18:I19") 

    'or if you want a different delimiter: 
    MergeRowByRow Range("A18:I19"), "|" 

End Sub 

Sub MergeRowByRow(SourceRange As Range, Optional Sigh As String = ";") 

    Dim rRow As Range 
    Dim rCell As Range 
    Dim xOut As String 

    For Each rRow In SourceRange.Rows 
     xOut = "" 
     For Each rCell In rRow.Cells 
      If rCell.Value <> "" Then 
       xOut = xOut & rCell.Value & Sigh 
      End If 
     Next rCell 
     Application.DisplayAlerts = False 
     rRow.Merge 
     Application.DisplayAlerts = True 
     If Len(rRow.Cells(1).Value) > 0 Then 
      rRow.Cells(1).Value = Left(xOut, Len(xOut) - 1) 
     End If 
    Next rRow 

End Sub

我已經更新了這樣的空白單元格將不會導致連續兩個分隔符，如果最終的結果是一個空白單元格取出的時候就不會報錯了最後一個分隔符。

來源

2015-08-25 11:11:28

這正是我正在尋找，但有一個問題有些行沒有任何信息在'中間名'列。有了這個查詢，它仍然放在;，所以它看起來像約翰;; Doe。有什麼辦法可以阻止這種情況發生？ –

我已經更新了兩個分隔符 - 如果這導致一個空單元格，它將不會在嘗試刪除最後一個字符時崩潰。 –

完美，這正是我所需要的。謝謝你的幫助 –

嗨，這裏有一個簡單的2代碼。我測試兩個範圍A2：C3（第一，中，姓氏）和A11的一些日期：C13 它改變你

Sub CompactNameIntoOneCell() 
Dim str As String 
str = "name" & vbCrLf 

    For i = 2 To 4 
     For Each cell In Range("A" & i, "C" & i) 
      str = str & cell & "," 
     Next cell 
     str = str & vbCrLf 
    Next i 
' if you want only one cell 
Range("A2", "C4").ClearContents 
Range("A2").Select 
Selection.Value = str 

'if you want merce the range into one cell 
Range("A11", "C13").ClearContents 
Range("A11").Select 
Selection.Value = str 
Range("A11:C13").Select 

    Selection.Merge 
    With Selection 'format to your like 
     .HorizontalAlignment = xlLeft 
     .VerticalAlignment = xlCenter 
     .WrapText = True 
     .Orientation = 0 
     .AddIndent = False 
     .IndentLevel = 0 
     .ShrinkToFit = False 
     .ReadingOrder = xlContext 
     .MergeCells = True 
    End With 
End Sub

來源

2015-08-25 11:25:26 Fabrizio

同樣的結果可以用下面的腳本，你選擇後可以了鼠標的部分你想處理該腳本：

sub Merge_Text() 
     for each c in Selection 
      if c.Value <> "" then c.Value = c.Value & "; " & c.Offset(0,1).Value & "; " & c.Offset(0,2).Value 
      c.Offset(0,1).Value = "" 
      c.Offset(0,2).Value = "" 
     next 
    end sub

來源

2015-08-25 11:28:29

在每一行中合併單元格

回答

相關問題