VBA循环合并特定范围内的单元格

Question

我有一个指定的范围，想要合并每行的单元格 A-D。我不确定哪个循环是最好的，并且搞砸了不同的循环，我遇到的问题是对象定义的错误或将整个范围合并到一个单元格中。

Sub Merge()

Dim EndRangeRE As Range
Dim EndRangeNRE As Range
Dim rngall As Range
Dim StartRangeNRE As Range
Dim StartRangeRE As Range
Dim looprng As Range

Sheets("{Activity} 7300-1input template").Activate
Set rngall = Sheets("{Activity} 7300-1input template").UsedRange
Set EndRangeRE = rngall.Find(What:="10. Other Costs", LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=True)
Set EndRangeNRE = rngall.Find(What:="Recurring Costs", LookIn:=xlValues,LookAt:=xlWhole, MatchCase:=True)
Set StartRangeNRE = rngall.Find(What:="Non-Recurring Costs",LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=True)
Set StartRangeRE = rngall.Find(What:="Recurring Costs", LookIn:=xlValues,LookAt:=xlWhole, MatchCase:=True)
Set looprng = Sheets("{Activity} 7300-1input template").Range(StartRangeNRE, EndRangeRE)

For Each Row In looprng
    Cells(0, 4).Merge
Next Row

End Sub

这给了我一个错误，我不确定如何指定每一行、A:D 合并和下一行。它会是一个do循环吗？我对实现这一目标的最简单方法持开放态度，因此很高兴提出建议（我在编码方面没有太多经验，所以有什么可以帮助我学习的！）。谢谢！

Answer 1

也许你在追求这个：

Option Explicit

Sub Merge()
    Dim EndRangeRE As Range, StartRangeNRE As Range
    Dim myRow As Range

    With Sheets("{Activity} 7300-1input template")
        With .UsedRange
            Set EndRangeRE = .Find(What:="10. Other Costs", LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=True)
            Set StartRangeNRE = .Find(What:="Non-Recurring Costs", LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=True)
        End With

        For Each myRow In .Range(StartRangeNRE, EndRangeRE).Rows
            .Rows(myRow.row).Resize(, 4).Merge
        Next
    End With
End Sub

我摆脱了未使用的变量并使用一些With-End With 块来引用同一对象的多个引用

Answer 2

这会将 A 到 D 合并为 100 行：

Sub ytrewq()
    For i = 1 To 100
        Range("A" & i & ":D" & i).MergeCells = True
    Next i
End Sub

编辑#1：

Sub ytrewq()
    For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row
        Range("A" & i & ":D" & i).MergeCells = True
    Next i
End Sub

Answer 3

试试这个代码：

 Sub test()
        'Get The Last non empty row
        lastRow = ThisWorkbook.Sheets("YourSheetName").Cells(Rows.Count, 1).End(xlUp).Row

        For i = 1 To lastRow
            ThisWorkbook.Sheets("YourSheetName").Range("A" & i & ":D" & i).Merge
        Next i

 End Sub

Answer 4

下面的代码合并了looprng 范围内“A:D”列中的单元格。

代码

Option Explicit

Sub Merge()

Dim EndRangeRE As Range
Dim EndRangeNRE As Range
Dim rngall As Range
Dim StartRangeNRE As Range
Dim StartRangeRE As Range
Dim looprng As Range
' 2 added object variables      
Dim Sht As Worksheet
Dim myRow As Range   

' set your worksheet object, don't need to Activate it
Set Sht = ThisWorkbook.Sheets("{Activity} 7300-1input template")    
Set rngall = Sht.UsedRange

Set EndRangeRE = rngall.Find(What:="10. Other Costs", LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=True)
Set EndRangeNRE = rngall.Find(What:="Recurring Costs", LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=True)
Set StartRangeNRE = rngall.Find(What:="Non-Recurring Costs", LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=True)
Set StartRangeRE = rngall.Find(What:="Recurring Costs", LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=True)

Set looprng = Sht.Range(StartRangeNRE, EndRangeRE)

' merge cells in columns "A:D" in your range
For Each myRow In looprng.Rows
    Sht.Range(Sht.Range("A" & myRow.Row), Sht.Range("D" & myRow.Row)).Merge
Next myRow

End Sub