セルの値に基づいてセルを結合する

Question

その行のセルに値が存在する場合、そのセルを行に結合しようとしています。

データは.txtファイルからインポートされ、さまざまなサブヘッダーが2列、3列または4列に分割されます。

データは最初のセルからのみ保持されるため、セルはマージできません。

常に一定であるだけの言葉は「含まれている」と列Bの「ため」されている

私が試したことは、このようになります。

cell.Value場合は「はが含まれている」のように、または "の場合"とし、列 "A"から列 "H"までのすべてのセルを列 "B"に結合し、それらを中央で整列させて太字にします。

ご協力いただきありがとうございます。

ここで編集コードです：

Sub Joining() 
    Dim N As Long, i As Long, r1 As Range, r2 As Range 
Dim z As Long 
Dim arr() As Variant 
z = 1 

With Activesheet 
    N = .Cells(Rows.Count, "A").End(xlUp).Row 
    For i = 1 To N 
     If .Cells(i, "B").Value Like "Summary*" Then 
      arr = .Range(.Cells(i, "A"), .Cells(i, "H")).Value 
      .Cells(z, "B").Value = Join(arr, " ") 
      z = z + 1 
     End If 
    Next i 
End With 

End Subの

Answer 1

オクラホマので、I答えを作りましたが、それはかなり（私が作成したプロジェクト全体のような）かなりありません。

私は確かにそれを作成するはるかに簡単な方法があると確信しています。

誰かがそれを掃除してもらえますか？

Sub SelRows() 

Dim ocell As Range 
Dim rng As Range 
Dim r2 As Range 

For Each ocell In Range("B1:B1000") 

    If ocell.Value Like "*contain*" Then 

     Set r2 = Intersect(ocell.EntireRow, Columns("A:G")) 

     If rng Is Nothing Then 

      Set rng = Intersect(ocell.EntireRow, Columns("A:G")) 
     Else 

      Set rng = Union(rng, r2) 
     End If 
    End If 
Next 

Call JoinAndMerge 


If Not rng Is Nothing Then rng.Select 

Set rng = Nothing 
Set ocell = Nothing 
End Sub 

Private Sub JoinAndMerge() 
Dim outputText As String, Rw As Range, cell As Range 
delim = " " 
Application.ScreenUpdating = False 
For Each Rw In Selection.Rows 
For Each cell In Rw.Cells 
    outputText = outputText & cell.Value & delim 
Next cell 
With Rw 
.Clear 
.Cells(1).Value = outputText 
.Merge 
.HorizontalAlignment = xlCenter 
.VerticalAlignment = xlCenter 
.WrapText = True 
End With 
outputText = "" 
Next Rw 
Application.ScreenUpdating = True 
End Sub 

Answer 2

ない、これは正確に何をしたいですが、それはあなたが閉じて取得するかどうかわから：

Sub summary() 
    Dim sh1 As Worksheet, sh2 As Worksheet 
    Dim N As Long, i As Long, r1 As Range, r2 As Range 
    Dim z As Long 
    Dim arr() As Variant 
    z = 1 
    Set sh1 = ActiveSheet 
    With ActiveWorkbook 
     Set sh2 = .Worksheets.Add(After:=.Sheets(.Sheets.Count)) 
    End With 

    With sh1 
     N = .Cells(Rows.Count, "A").End(xlUp).Row 
     For i = 1 To N 
      If .Cells(i, "A").Value Like "Summary*" Then 
       arr = .Range(.Cells(i, "A"), .Cells(i, "H")).Value 
       sh2.Cells(z, "A").Value = Join(arr, " ") 
       z = z + 1 
      End If 
     Next i 
    End With 
End Sub