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

时间:2017-11-10 20:22:36

标签: excel vba excel-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

enter image description here

enter image description here

2 个答案:

答案 0 :(得分:2)

你能试试吗?我认为你可以通过循环缩短你的代码。我认为这个错误是由于细胞的合并导致了查找。由于许多原因,合并细胞是一个坏主意。

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

答案 1 :(得分:1)

从ASCII字符65(例如A)到ASCII字符90(例如Z)的循环应清理您的代码。

as.Date