[英]How can I run this VBA code across each sheet in my workbook?
I have a workbook of 60 sheets, each with identical formatting.我有一个 60 张工作簿,每张都有相同的格式。 I need to merge a bunch of cells in each one, so I have this code to do that.
我需要在每个单元格中合并一堆单元格,所以我有这段代码可以做到这一点。 Is there a way I can run it across the entire document rather than have to run it individually on each sheet?
有没有一种方法可以在整个文档中运行它,而不必在每张纸上单独运行它?
Sub MrgeColumns()
Range("T3:T209").Merge
Range("AU3:AU209").Merge
Range("BT3:BT209").Merge
Range("CS3:CS209").Merge
Range("DS3:DS209").Merge
Range("ET3:ET209").Merge
Range("FT3:FT209").Merge
Range("GR3:GR209").Merge
Range("HP3:HP209").Merge
Range("IN3:IN209").Merge
End Sub
Give it a worksheet argument, and then you can call it using a loop.给它一个工作表参数,然后你可以使用循环调用它。
Sub MergeAll()
Dim ws as Worksheet
For each ws in ActiveWorkbook.WorkSheets
MrgeColumns ws
Next
End Sub
Sub MrgeColumns(ws as Worksheet)
With ws
.Range("T3:T209").Merge
.Range("AU3:AU209").Merge
.Range("BT3:BT209").Merge
.Range("CS3:CS209").Merge
.Range("DS3:DS209").Merge
.Range("ET3:ET209").Merge
.Range("FT3:FT209").Merge
.Range("GR3:GR209").Merge
.Range("HP3:HP209").Merge
.Range("IN3:IN209").Merge
End With
End Sub
Option Explicit
' Merges the column ranges in all worksheets.
Sub TESTmergeColumnRanges()
Const ColumnList As String = "T,AU,BT,CS,DS,ET,FT,GR,HP,IN"
Const FirstRow As Long = 3
Const LastRow As Long = 209
mergeColumns ThisWorkbook, ColumnList, FirstRow, LastRow
End Sub
' Merges the column ranges in worksheets whose names are not
' in the Exceptions List.
Sub TESTmergeColumnRangesWithExceptions()
Const ExceptionList As String = "Sheet2,Sheet4"
Const ColumnList As String = "T,AU,BT,CS,DS,ET,FT,GR,HP,IN"
Const FirstRow As Long = 3
Const LastRow As Long = 209
mergeColumns ThisWorkbook, ColumnList, FirstRow, LastRow, ExceptionList
End Sub
' Unmerges the column ranges in all worksheets.
Sub TESTunMergeColumnRanges()
Const ColumnList As String = "T,AU,BT,CS,DS,ET,FT,GR,HP,IN"
Const FirstRow As Long = 3
Const LastRow As Long = 209
mergeColumns ThisWorkbook, ColumnList, FirstRow, LastRow, , False
End Sub
Sub mergeColumns( _
wb As Workbook, _
ByVal ColumnList As String, _
ByVal FirstRow As Long, _
ByVal LastRow As Long, _
Optional ByVal ExceptionList As String, _
Optional ByVal doMerge As Boolean = True)
Dim Cols() As String: Cols = Split(ColumnList, ",")
Dim ws As Worksheet
Dim n As Long
If ExceptionList = "" Then
For Each ws In wb.Worksheets
mergeColumnsInWorksheet ws, Cols, FirstRow, LastRow, doMerge
Next ws
Else
Dim Exceptions() As String: Exceptions = Split(ExceptionList, ",")
For Each ws In wb.Worksheets
If IsError(Application.Match(ws.Name, Exceptions, 0)) Then
mergeColumnsInWorksheet ws, Cols, FirstRow, LastRow, doMerge
End If
Next ws
End If
End Sub
Sub mergeColumnsInWorksheet( _
ws As Worksheet, _
Cols() As String, _
ByVal FirstRow As Long, _
ByVal LastRow As Long, _
Optional ByVal doMerge As Boolean = True)
Dim n As Long
With ws.Rows(FirstRow & ":" & LastRow)
If doMerge Then
For n = 0 To UBound(Cols)
.Columns(Cols(n)).Merge
Next n
Else
For n = 0 To UBound(Cols)
.Columns(Cols(n)).UnMerge
Next n
End If
End With
End Sub
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.