1つのExcel列の値を、同じ行の可変数の列から連結された値に置き換えるにはどうすればよいですか？

debugcn 投稿 Dev

ベス

エクスポートされたExcelレポートの出力を変換しようとしています。このレポートには、データを含む列の数が可変である多くの行が含まれています。エクスポートは変更できません。それは私が一緒に働かなければならないものです。

列Aには、テキストが含まれる場合と含まれない場合があります。列Bには、この問題に関係のないデータが含まれています（邪魔であり、コーディングする必要がある場合を除く）。列C、D以降にはテキストが含まれる場合と含まれない場合がありますが、これらのテキストの塗りつぶしは一貫しており、左から右に順番に並んでいます。つまり、列Eがテキストを含む行の最後の列である場合、列は列を「スキップ」しません。 DとCにもテキストが含まれます。

私の目標は、これらすべての個別のテキスト値を各行の列Aセルに連結し（縦線文字で区切る）、列Aと列Bにのみ値を残すことです。

したがって、エクスポートが次のようになっている場合：

      ColA   ColB   ColC   ColD

Row1  Alpha  xxxxx
Row2
Row3  Gamma  xxxxx  Theta
Row4
Row5  Delta  xxxxx  Kappa  Sigma

変換された出力は次のようになります。

      ColA                   ColB   ColC   ColD

Row1  Alpha                  xxxxx
Row2
Row3  Gamma | Theta          xxxxx  
Row4
Row5  Delta | Kappa | Sigma  xxxxx

（私はそれらが素晴らしい表現ではないことを知っていますが、画像を埋め込むことはできません。これがExcelシートの「前」の写真と「後」の写真です）

そして今、これが私がこれまでにコーディングしたものです。列Aと列Cを連結するように設定されているだけです。範囲の設定とテキスト文字列間の垂直線の書式設定に関して正しい方向に進んでいるように感じますが、行—列Aで連結されたテキスト文字列を作成し、ルーチンが完了したら列C以降の値を削除します。

Sub ColumnConcat()

Dim firstComment As Range
Set firstComment = Range("A1")

Dim lastComment As Range
Set lastComment = Range("B1").End(xlDown).Offset(0, -1)

Dim commentRange As Range
Set commentRange = Range(firstComment, lastComment)

Dim commentCell As Range

For Each commentCell In commentRange

  If IsEmpty(commentCell.Offset(0, 2).Value) = True Then
    commentCell.Value = commentCell

      Else

    Dim firstConcatComment As Range
    Set firstConcatComment = commentCell.Offset(0, 2)

    commentCell.Value = commentCell & " | " & firstConcatComment

  End If

Next commentCell

Range("C1:E1").EntireColumn.Delete Shift:=xlToLeft

End Sub

スコット・クラナー

このような場合は、全体を配列にロードしてから、その配列を反復処理して2番目の配列をロードすることを好みます。

シート上のデータを何度も参照するのではなく、数回しか参照しないため、範囲を反復処理するよりも高速です。

Sub ColumnConcat()
Dim ws As Worksheet
Set ws = Worksheets("Sheet28") 'Change to your sheet name or ActiveSheet.


Dim rngArr() As Variant
Dim OArr() As Variant
rngArr = ws.UsedRange
ReDim OArr(LBound(rngArr, 1) To UBound(rngArr, 1), 1 To 2) As Variant

For i = LBound(rngArr, 1) To UBound(rngArr, 1)
    OArr(i, 1) = rngArr(i, 1) & " | "
    OArr(i, 2) = rngArr(i, 2)
    For j = 3 To UBound(rngArr, 2)
        If rngArr(i, j) = "" Then Exit For
        OArr(i, 1) = OArr(i, 1) & rngArr(i, j) & " | "
    Next j
    If OArr(i, 1) <> "" Then
        OArr(i, 1) = Left(OArr(i, 1), Len(OArr(i, 1)) - 3)
    End If
Next i

ws.UsedRange.Clear
ws.Range("A1").Resize(UBound(OArr, 1), UBound(OArr, 2)).Value = OArr
End Sub

前：