4

これについて新しいスレッドを作成して申し訳ありませんが、既存のスレッドにコメントできませんでした。

このスレッドとまったく同じように多くのセルをマージしようとしていますが、コーディング、特に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 からマクロを追加し、そこにコードを貼り付けて保存しました。

助けてくれてありがとう
//Joakim

4

1 に答える 1

2

コードの 2 つのバージョンを次に示します。

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

スクリーンショット

ここに画像の説明を入力

于 2013-09-13T11:34:37.110 に答える