循环通过排除指定工作表的工作表
Posted
技术标签:
【中文标题】循环通过排除指定工作表的工作表【英文标题】：Looping Through Worksheets Excluding Specified Worksheets 【发布时间】：2021-08-03 05:50:40 【问题描述】：我想从单个工作簿中的指定工作表中获取数据，然后从这些工作表中创建单独的电子邮件。
代码不会对每个工作表执行操作，然后移动到下一个。
我还想从操作中排除指定的工作表。
我在一个单独的模块中利用了 Ron DeBruin 的 Rangetohtml 函数。
Sub ClientEvent_Email_Generation()
Dim OutApp As Object
Dim OutMail As Object
Dim count_row, count_col As Integer
Dim Event_Table_Data As Range
Dim Event2_Table_Data As Range
Dim strl As String, STR2 As String, STR3 As String
Dim WS As Worksheet
Dim I As Integer
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
For Each WS In ThisWorkbook.Sheets
WS.Activate
If ActiveSheet.Name <> "DATA INPUT" Then Or "FORMATTED DATA TABLE" Or "REP CODE MAPPING TABLE" Or "IDEAS TAB" Then
count_row = WorksheetFunction.CountA(Range("A10", Range("a10").End(xlDown)))
count_col = WorksheetFunction.CountA(Range("A10", Range("a10").End(xlToRight)))
Set Event_Table_Data = ActiveSheet.Cells.Range(Cells(9, 1), Cells(count_row, count_col))
Set Event2_Table_Data = Sheets("w61").Range(Cells(9, 1), Cells(count_row, count_col))
str1 = "<BODY style=font-size:12pt;font-family:Times New Roman>" & _
"Hello " & Range("L3").Value & ",<br><br>The following account(s) listed below appear to have an upcoming event<br>"
STR2 = "<br>Included are suggestions for an activity which may fit your client's needs.<br>"
STR3 = "<br>You may place an order, or contact us for alternate ideas if these don't fit your client."
On Error Resume Next
With OutMail
.To = ActiveSheet.Range("l4").Value
.cc = ""
.bcc = ""
.Subject = "Upcoming Event In Your Clients' Account(s)"
.display
.HTMLBody = str1 & RangetoHTML(Event_Table_Data) & STR2 & RangetoHTML(Event2_Table_Data) & STR3 & .HTMLBody
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End If
Next WS
End Sub
【问题讨论】：
您需要限定所有范围和单元格引用：例如WorksheetFunction.CountA(WS.Range( 和WS.Cells.Range(WS.Cells(。为什么你有时使用ActiveSheet，有时使用WS，如果它们是同一个东西？
你有一个多余的 Then 在不需要它的地方，所以这段代码甚至不会编译：If ActiveSheet.Name <> "DATA INPUT" Then Or "FORMATTED DATA TABLE"... 你只需要该行末尾的 Then
【参考方案1】：
循环（迭代）工作表
以下将循环遍历包含此代码 (ThisWorkbook) 的工作簿中的每个工作表，并打印未包含在 Exceptions List (Exceptions 数组) 和“非空”范围内的每个工作表名称单元格 A9 到 Immediate window (VBE: Ctrl+G.
首先按原样运行它以查看结果是否令人满意，然后才在需要限定范围和单元格的地方添加您的电子邮件代码（不清楚），即使用ws 而不是ActiveSheet 和@987654329 @ 在Cells 或Range 前面（ws.Cells(...)、ws.Range(...) 如果其中任何一个是，或者是循环中当前工作表的一部分。
可能有更可靠的方法（请参阅this answer 到使用 VBA 在 Excel 中查找最后使用的单元格时出错）来定义（创建引用）范围，但此处的重点已设置在循环中（使用ACount 更不可靠）。
Option Explicit
Sub loopThroughWorksheets()
Const sFirst As String = "A9"
Const ExceptionsList As String _
= "DATA INPUT,FORMATTED DATA TABLE,REP CODE MAPPING TABLE,IDEAS TAB"
Dim Exceptions() As String: Exceptions = Split(ExceptionsList, ",")
Dim wb As Workbook: Set wb = ThisWorkbook
Dim sws As Worksheet
Dim srg As Range ' "Event_Table_Data"
Dim fCell As Range
Dim rCount As Long, cCount As Long
For Each sws In wb.Worksheets
If IsError(Application.Match(sws.Name, Exceptions, 0)) Then
Set fCell = sws.Range(sFirst)
rCount = sws.Range(fCell, fCell.End(xlDown)).Cells.Count
cCount = sws.Range(fCell, fCell.End(xlToRight)).Cells.Count
Set srg = fCell.Resize(rCount, cCount)
' e.g.:
Debug.Print sws.Name, srg.Address
' Your email code (per worksheet) here.
'Else
' Worksheet is in Exceptions Array: do nothing, or...
End If
Next sws
End Sub
【讨论】：
以上是关于循环通过排除指定工作表的工作表的主要内容，如果未能解决你的问题，请参考以下文章