vba - 循环遍历一行并将单元格合并为标题 vba

Question

这是我昨天的问题的补充，所以我开始一个新问题。基本上，我在 excel 的工作表上得到不同范围的数据，并且数据范围每周都不同，因此最后使用的列和最后使用的行会有所不同。

我想根据名称合并第 3 行和第 4 行，我将发布一个示例数据，以便您了解我想要实现的目标。第 3 行是具有名称的行，第 4 行始终为空。现在，我收到 error 91, Object variable or With block variable not set on 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