excel 组合

jk9hmnmh 于 2023-11-20 发布在其他

关注(0)|答案(1)|浏览(138)

如果该行已合并行，则尝试将合并行值合并。
这是原来的

的数据
这是意料之中的。

的
谢谢
这是我目前工作的脚本。但我需要找到一种方法来确定行是否合并了单元格，然后其他列将合并合并为1个单元格。

Sub TestCopy()

Dim Src As Range
Set Src = Range("A1:A2")
   
Dim Dst As Range
Set Dst = Range("A5")

Dim DstRow As Range
Set DstRow = Range("A5:A6")
    
Dim myArray() As String
Dim intCount As Integer
Dim c As Range

ReDim myArray(Src.Rows.Count - 1)
intCount = 0
For Each c In Src
myArray(intCount) = c.Value
intCount = intCount + 1
'MsgBox Join(myArray, vbCrLf)
Next c

Dst = Join(myArray, vbCrLf)

End Sub

字符串

excel

来源：https://stackoverflow.com/questions/77406789/vba-combining-rows

1条答案

按热度按时间

zed5wv101#

我想这就是你要找的。

Option Explicit

Sub MergeCell()
    Dim c As Range, d As Range, sTxt As String
    Dim dataRng As Range, aRng As Range
    Set dataRng = Range("B1", Cells(Rows.Count, 2).End(xlUp))
    Application.DisplayAlerts = False
    ' Loop through column B
    For Each c In dataRng
        sTxt = ""
        If Len(c.Value) > 0 Then
            ' Locate merged cell
            If c.MergeArea.Cells.Count > 1 Then
                ' Get the related range in column A
                Set aRng = c.Offset(0, -1).Resize(c.MergeArea.Cells.Count)
                ' Cocat text
                For Each d In aRng.Cells
                    If Len(d.Value) > 0 Then
                        sTxt = sTxt & Chr(10) & d.Value
                    End If
                Next
                ' Merge cell and update its value
                aRng.Merge
                aRng.Value = Mid(sTxt, 2)
            End If
        End If
    Next
    Application.DisplayAlerts = True
End Sub

字符串

的数据

赞(0）回复(0）举报 2023-11-20

我来回答

excel 组合

1条答案

相关问题

热门标签

最新问答