[英]Merging cells in Excel without loosing data
首先抱歉有關於此的新線程,但我無法在現有線程中發表評論。
我正在嘗試合並很多單元格,就像在這個線程中一樣,但我對編碼很新,尤其是excel / VBA,所以我不能讓它工作。 我有相同的場景(除了我沒有任何空行)所以我只是嘗試使用現有線程中的代碼而不是真正理解語法:
Sub mergecolumn()
Dim cnt As Integer
Dim rng As Range
Dim str As String
For i = ActiveSheet.UsedRange.Rows.Count To 1 Step -1
cnt = Cells(i, 1).MergeArea.Count
Set rng = Range(Cells(i, 2), Cells(i - cnt + 1, 2))
For Each cl In rng
If Not IsEmpty(cl) Then str = str + vbNewLine + cl
Next
If str <> "" Then str = Right(str, Len(str) - 2)
Application.DisplayAlerts = False
rng.Merge
rng = str
Application.DisplayAlerts = True
str = ""
i = i - cnt + 1
Next i
End Sub
我試圖以不同的方式運行宏標記多個列,標記多行並標記一些區域,但我總是得到:
運行時錯誤'13':
類型不匹配
當我進入調試屏幕時,標記為:
str = str + vbNewLine + cl
我通過Developer-ribbon-> Visual Basic-> Insert-> Module添加了宏,只是將代碼粘貼到那里並保存。
在此先感謝您的幫助
//喬金 -
這是代碼的兩個版本。
VER 1 (不忽略空白單元格)
'~~> For Group MERGING (Merge Cells and Keep All text)
Public Sub Sample()
On Error GoTo ErrMergeAll
Application.DisplayAlerts = False
Dim Cl As Range
Dim strTemp As String
'~~> Collect values from all the cells and separate them with spaces
For Each Cl In Selection
If Len(Trim(strTemp)) = 0 Then
strTemp = strTemp & Cl.Value
Else
strTemp = strTemp & vbNewLine & Cl.Value
End If
Next
strTemp = Trim(strTemp)
'~~> Merging of cells
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.MergeCells = False
End With
Selection.Merge
'~~> Set new value of the range
Selection.Value = strTemp
Application.DisplayAlerts = True
Exit Sub
ErrMergeAll:
MsgBox Err.Description, vbInformation
Application.DisplayAlerts = True
End Sub
VER 2 (忽略空白單元格)
'~~> For Group MERGING (Merge Cells and Keep All text)
Public Sub Sample()
On Error GoTo ErrMergeAll
Application.DisplayAlerts = False
Dim Cl As Range
Dim strTemp As String
'~~> Collect values from all the cells and separate them with spaces
For Each Cl In Selection
If Len(Trim(Cl.Value)) <> 0 Then
If Len(Trim(strTemp)) = 0 Then
strTemp = strTemp & Cl.Value
Else
strTemp = strTemp & vbNewLine & Cl.Value
End If
End If
Next
strTemp = Trim(strTemp)
'~~> Merging of cells
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.MergeCells = False
End With
Selection.Merge
'~~> Set new value of the range
Selection.Value = strTemp
Application.DisplayAlerts = True
Exit Sub
ErrMergeAll:
MsgBox Err.Description, vbInformation
Application.DisplayAlerts = True
End Sub
屏幕截圖
聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.