Excel VBAで隣接するセルを連結する方法

Question

私は単一の列にデータを持っています。 いくつかのセルは、（1）、（2）などのように "index"で始まります。 このようなセルを順番に連結し、その結果を次の列に置き、元のセルをクリアします。 VBAでこれを行う方法を教えてください。ありがとうございました！

画像をご覧ください：col_A has the data, col_C and col_D are the desired result

Answer 1

あなたはこのような何かを行うことができます。私はあなたのサンプルの場合のみテストしたので、私はそれを保証することはできません。したがって、連続していない番号の付いたサブエントリでは機能しません。また、サブエントリが順序どおりでない場合にも機能しません。後でどちらも、あなた自身でリファクタリングする必要があるより堅牢なバージョンに組み込むことができます。実際に正規表現は、後者を実装したい場合にはすでにサブエントリ＃を取り上げています。

Sub process() 
Dim maxRow As Integer: maxRow = 100 
Dim items As Collection 
Dim regEx As Object 
Dim matches As Object 
Set items = New Collection 

Set re = CreateObject("vbscript.regexp") 
re.Global = True 
re.IgnoreCase = True 
re.Pattern = "\((\d+)\).*" 

Dim val As String 
Dim row As Integer, rowPtr As Integer: row = 1 
Dim matchTest As Boolean, preMatchTest As Boolean: preMatchTest = False 
Do While row < maxRow: 
    val = Cells(row, "A").Value 
    matchTest = re.Test(val) 
    If Not preMatchTest And matchTest Then 
    rowPtr = row 
    Do While row < maxRow + 1: 
     val = Cells(row, "A").Value 
     matchTest = re.Test(val) 
     If matchTest Then 
      Set matches = re.Execute(val) 
      itemNum = matches(0).submatches(0) 
      items.Add val 
      Cells(row, "A") = "" 
     Else 
      For Each colVal In items: 
      Cells(rowPtr - 1, "B") = Cells(rowPtr - 1, "B") & colVal 
      Next 
      Set items = New Collection 
      Exit Do 
     End If 
     row = row + 1 
     preMatchTest = matchTest 
    Loop 
    End If 
    preMatchTest = False 
    row = row + 1 
Loop 

End Sub 

PREMATCH /マッチ文がサブエントリの開始を探し、見つかった場合は、一度「アイテムのコレクションに追加し、内側のループに入ります。最後のものが見つかると、コレクションは連結され、メインエントリの保存された場所（ 'rowPtr'）に保存されます。また、列 'A'と（maxRow）で見た行の最大数はマクロにハードコードされていることにも注意してください。

Answer 2

あなたはAutoFilter()方法とRangeオブジェクト

Option Explicit 

Sub main() 
    Dim area As Range 

    With Range("A1", Cells(Rows.Count, 1).End(xlUp)).Offset(, 2) 
     .Offset(, -2).Copy .Cells 
     .AutoFilter Field:=1, Criteria1:="(*" 
     If Application.WorksheetFunction.Subtotal(103, .Cells) > 1 Then 
      For Each area In .Resize(.Rows.Count - 1).Offset(1).SpecialCells(xlCellTypeVisible).Areas 
       area(1).Offset(-1, 1).Value = Join(Application.Transpose(area.Value), "") 
       area.ClearContents 
      Next 
     End If 
     .Parent.AutoFilterMode = False 
    End With 
End Sub