各セルを縦に読み込んで行き、正規表現で整形しながら横のセルに出力していくVBAのサンプルコード

Sub ボタン1_Click()

    Dim i As Long
    Dim maxRow As Long
    
    minRow = 2
    maxRow = Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row '最終行
    
    '正規表現オブジェクトの設定
    Dim reg As Object
    Set reg = CreateObject("VBScript.RegExp")
    With reg
        .Pattern = "B+"  '正規表現パターン
        .IgnoreCase = False   '大文字と小文字を区別する
        .Global = True        '文字列全体を検索するか(True)
    End With
    
    For i = minRow To maxRow
        
        Cells(i, 2).Value = reg.Replace(Cells(i, 1).Value, "B")
        
    Next i
    
End Sub