行をループし、セルをヘッダーvbaとしてマージする

Question

これは私の質問に追加されたので、私は新しい質問を開始しています。基本的にExcelのシート上のさまざまなデータ範囲が得られ、データの範囲は毎週変わります。したがって、最後に使用された列と最後に使用された行は異なります。

名前に基づいて3行目と4行目をマージしたいのですが、達成しようとしていることを理解できるようにサンプルデータを投稿します。行3は名前を持ち、行4は常に空です。今のところ、私はerror 91, Object variable or With block variable not setをLoop Whileで取得しています。

また、写真に最も適しているので、3つの範囲しか表示していません。

Sub test() 

'Set Up 

Dim f, g, h, i, j, k As Range 
Dim firstaddress As String 
Dim ws1 As Worksheet 



Set ws1 = Sheets("Sheet1") 




'Merge back 
With ws1.Rows(3) 
    Set f = .Find("A", LookIn:=xlValues) 
    If Not f Is Nothing Then 
     firstaddress = f.Address 
     Do 
      Range(f.Resize(2), f.Resize(, 1)).Merge 
      Range(f.Resize(2), f.End(xlToRight)).BorderAround LineStyle:=xlContinuous, Weight:=xlMedium 
      Set f = .FindNext(f) 

     Loop While Not f Is Nothing And f.Address <> firstaddress 
    End If 
End With 

With ws1.Rows(3) 
    Set g = .Find("B", LookIn:=xlValues) 
    If Not g Is Nothing Then 
     firstaddress = g.Address 
     Do 
      Range(g.Resize(2), g.Resize(, 1)).Merge 
      Range(g.Resize(2), g.End(xlToRight)).BorderAround LineStyle:=xlContinuous, Weight:=xlMedium 
      Set g = .FindNext(g) 
     Loop While Not g Is Nothing And g.Address <> firstaddress 
    End If 
End With 


With ws1.Rows(3) 
    Set h = .Find("C", LookIn:=xlValues) 
    If Not h Is Nothing Then 
     firstaddress = h.Address 
     Do 
      Range(h.Resize(2), h.Resize(, 1)).Merge 
      Range(h.Resize(2), h.End(xlToRight)).BorderAround LineStyle:=xlContinuous, Weight:=xlMedium 
      Set g = .FindNext(h) 
     Loop While Not h Is Nothing And h.Address <> firstaddress 
    End If 
End With 


With ws1.Rows(3) 
    Set i = .Find("D", LookIn:=xlValues) 
    If Not i Is Nothing Then 
     firstaddress = i.Address 
     Do 
      Range(i.Resize(2), i.Resize(, 1)).Merge 
      Set i = .FindNext(i) 
     Loop While Not i Is Nothing And i.Address <> firstaddress 
    End If 
End With 

With ws1.Rows(3) 
    Set j = .Find("E", LookIn:=xlValues) 
    If Not j Is Nothing Then 
     firstaddress = j.Address 
     Do 
      Range(j.Resize(2), j.Resize(, 1)).Merge 
      Range(j.Resize(2), j.End(xlToRight)).BorderAround LineStyle:=xlContinuous, Weight:=xlMedium 
      Set j = .FindNext(j) 
     Loop While Not j Is Nothing And j.Address <> firstaddress 
    End If 
End With 


With ws1.Rows(3) 
    Set k = .Find("F", LookIn:=xlValues) 
    If Not k Is Nothing Then 
     firstaddress = k.Address 
     Do 
      Range(k.Resize(2), k.Resize(, 1)).Merge 
      Set k = .FindNext(k) 
     Loop While Not k Is Nothing And k.Address <> firstaddress 
    End If 
End With 


End Sub 

Answer 1

あなたはこれを試すことができます。私はあなたのコードをループで短縮できると思います。私が思うエラーは、Findをねじ込むセルのマージによって引き起こされます。結合された細胞は、多くの理由で悪い考えです。

Sub test() 

'Set Up 
Dim f As Range 
Dim firstaddress As String 
Dim ws1 As Worksheet 
Dim v, i As Long 

Set ws1 = Sheets("Sheet1") 
v = Array("A", "B", "C", "D") 

'Merge back 
For i = LBound(v) To UBound(v) 
    With ws1.Rows(3) 
     Set f = .Find(v(i), LookIn:=xlValues) 
     If Not f Is Nothing Then 
      firstaddress = f.Address 
      Do 
       f.Resize(2).Merge 
       Range(f.Resize(2), f.End(xlToRight)).BorderAround LineStyle:=xlContinuous, Weight:=xlMedium 
       Set f = .FindNext(f) 
      Loop While Not f Is Nothing 
     End If 
    End With 
Next i 

End Sub 

Answer 2

ASCII文字65（たとえばA）からASCII文字90（たとえばZ）までのループがコードをクリーンアップする必要があります。

Option Explicit 

Sub Macro1() 
    Dim c As Long, firstaddress As String, f As Range, ffs As Range 

    With Worksheets("sheet1").Rows(3).Cells 
     .Resize(2, .Columns.Count).UnMerge 
     Set f = Nothing 
     For c = 65 To 90 
      Set f = .Find(Chr(c), LookIn:=xlValues, Lookat:=xlWhole) 
      If Not f Is Nothing Then 
       Set ffs = f 
       firstaddress = f.Address 
       Do 
        Set ffs = Union(f, ffs) 
        Set f = .FindNext(after:=f) 
       Loop While f.Address <> firstaddress 
       With Union(ffs, ffs.Offset(1)) 
        .Merge 
        .BorderAround LineStyle:=xlContinuous, Weight:=xlMedium 
       End With 
      End If 
     Next c 
    End With 
End Sub