循环遍历行并合并单元格作为标题vba

这是昨天我的问题的补充，所以我开始一个新的问题。 基本上，我在excel中获取不同范围的数据，数据范围每周都有所不同，所以最后使用的列和最后使用的行会有所不同。

我想根据名称合并第3和第4行，我将发布一个示例数据，以便您可以了解我正在尝试实现的内容。 第3行是具有名称的行，第4行总是空的。 现在，我得到error 91, Object variable or With block variable not set循环时，该行。

再一次，我只显示你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