VBA 工作薄中所有工作表怎么用代码表示

Posted 2023-05-07

我写成 if sheet.name = "ab" then
提示要求物件?
该怎么写?

在所有工作表中寻找某个工作表，需要循环遍历
代码如下：
Sub main
for each s in sheets\'以此循环遍历所有工作表
if s.name= "ABC" then’如果工作表的名称为“ABC”
.....\'则要执行的代码，此处省略，根据需要自行添加
exit for ‘找到工作表后，可以退出循环，提高效率
end if
next
end sub 参考技术A 给你个函数用：
---------------------
Function iExistsSheet(shNm) As Boolean
'检测当前工作薄中是否存在名字为 shNm 的工作表
On Error Resume Next
Dim sh As Worksheet
Set sh = Worksheets(shNm)
iExistsSheet = (Err.Number = 0)
Err.Clear
End Function
-----------------
下面是测试这个函数的程序：
Sub iTest()
Dim s As String, t As Boolean
s = "sheet1"
t = iExistsSheet(s)
MsgBox "工作表<" & s & ">" & IIf(t, "", "不") & "存在。"

'如果不存在，退出程序：
If Not t Then Exit Sub

'如果存在，并要使用这个工作表中的单元格 A1 的数据：
Dim ss
With Worksheets(s)
ss = .Range("A1")
MsgBox "工作表<" & s & ">中 单元格 A1 的值：" & ss
End With
End Sub 参考技术B 如果是当前工作表名,用 activesheet.name,如果要当前工作簿名则是 activeworkbook.name
如果要当前工作簿的所有工作表名或者指定第几个表名,则需要在循环中完成,引用方式为:
sheets(i).name追问

是不是把i定义为变量,,我设i为变量 i=i 1
if sheets(i).name = "abc" then
还是不能达到效果,我要找出工作薄是否有"ABC"的工作表

追答

这个肯定要用循环才能实现,都有i了,告诉你用循环了.

for i=1 to sheets.count
if sheets(i).name= "ABC" then
.....
endif
next

如果找到了就要退出循环的话,在endif之前还要加一个 exit for

本回答被提问者和网友采纳 参考技术C 工作薄中的所有工作表是一个集合 用sheets表示 如果你要遍历所有的工作表,判断某一个工作表的名称是不是你指定的.
代码的例子如下:
dim sht as range
for each sht in sheets
if sht.name="ab" then
.....
end if
next

或者
for i=1 to sheets.count
if sheets(i).name="ab" then
.....
end if
next i 参考技术D application.Worksheets(1).name="ABC"
application.Worksheets(2).name="ABCD"

合并Excel工作薄中成绩表的VBA代码，非常适合教育一线的朋友_python

这时候还需要把各个工作表合并到一起来形成一个汇总表。这时候比较麻烦也比较容易出错，因为各个表的学号不一定都是一致的、对齐的。因为可能会有人缺考，有人会考号涂错等等。特奉献以下代码，用于合并学生成绩表或者其它类似的表都可以。本代码特点在于不需要使用SQL或者Access等大头软件，只需要Excel就可以执行，非常方便，速度也不慢。转载请勿清除广告。 
没有合适的局域网管理软件吗？你的网管工具够灵活够高效吗？看看这个network management software。 
‘ ============================================= 
‘ 合并总表时，不参加计算的表格数目 
‘ 因为一般合并的总表放在最后一个工作表，要排除掉这个表。 
Const ExcludeSheetCount = 1 
‘ 主函数，因为用到了ADO，必须作如下引用才能运行本代码。 
‘ 工具>引用， 引用ADO(Microsoft ActiveX Data Objects 2.X Library) 
‘ 链接所有sheet到一个总表 
‘ 要合并的表的第一行必须是字段名称，不能是合并单元格 
Sub SQL_ADO_EXCEL_JOIN_ALL() 
Dim cnn As New ADODB.Connection 
Dim rs As New ADODB.Recordset 
Dim i, k, shCount As Integer 
Dim SQL, SQL2 As String, cnnStr As String 
Dim s1, s2, s3, tmp As String 
Dim ws As Worksheet 
Const IDIdx = 1 
Const ScoreIdx = 3 
shCount = ActiveWorkbook.Sheets.Count 
‘ 获取所有考号 
‘ EXCEL 会自动去除重复数据 
‘ SQL = "(select ID from [语文$]) union (select ID from [英语$]) union (select ID from [物理$]) order by ID" 
SQL = "" 
For i = 1 To shCount - ExcludeSheetCount 
s1 = "(SELECT ID FROM [" & Sheets(i).Name & "$])" 
If i = 1 Then 
SQL = s1 
Else 
SQL = SQL & " UNION " & s1 
End If 
Next 
‘MsgBox SQL 
Set ws = ActiveWorkbook.Sheets(shCount) 
cnnStr = "provider = microsoft.jet.oledb.4.0;Extended Properties=‘Excel 8.0;HDR=yes;IMEX=1‘;data source=" & ThisWorkbook.FullName 
cnn.CursorLocation = adUseClient 
cnn.ConnectionString = cnnStr 
cnn.Open 
rs.Open SQL, cnn, adOpenKeyset, adLockOptimistic 
ws.Activate 
ws.Cells.Clear 
For i = 1 To rs.Fields.Count 
ws.Cells(1, i) = rs.Fields(i - 1).Name 
Next 
ws.Range("A2").CopyFromRecordset rs 
For i = 1 To shCount - ExcludeSheetCount 
Sheets(shCount).Cells(1, i + 1) = Sheets(i).Name 
Next 
‘EXCEL 不支持 UPDATE 
‘SQL = "update [合并$] set 语文 = ‘1‘" 
‘ 相当于内联接 
‘SQL = "select tt.ID,ta.score as 语文,tb.score as 英语 from [合并$] AS tt, [语文$] as ta, [英语$] as tb " 
‘SQL = SQL & "where (tt.ID = ta.ID) and (tt.ID = tb.ID)" 
‘ 左联接所有表格 
‘ 通过测试的语句 
‘SQL = "select tt.ID,ta.score AS 语文,tb.score as 英语 from ([合并$] AS tt left join [语文$] as ta on tt.ID = ta.ID) " 
‘SQL = SQL & "left join光棍影院 [英语$] as tb on tt.ID = tb.ID" 
SQL2 = "([" & Sheets(shCount).Name & "$] AS tt LEFT JOIN [" & Sheets(1).Name & "$] AS t1 ON tt.id=t1.id) " 
SQL = "SELECT tt.ID," 
For i = 1 To shCount - ExcludeSheetCount 
tmp = "t" & i 
SQL = SQL & tmp & ".score AS " & Sheets(i).Name 
If i < shCount - ExcludeSheetCount Then SQL = SQL & ", " 
If i > 1 Then 
SQL2 = "(" & SQL2 & " LEFT JOIN [" & Sheets(i).Name & "$] AS " & tmp & " ON tt.id=" & tmp & ".id)" 
End If 
Next 
s1 = SQL & " FROM " & SQL2 & " ORDER BY tt.ID" 
MsgBox s1 
rs.Close 
rs.Open s1, cnn, adOpenKeyset, adLockOptimistic 
‘ 清除表格 
ws.Activate 
Cells.Select 
Selection.Delete Shift:=xlUp 
For i = 1 To rs.Fields.Count 
ws.Cells(1, i)http://www.bsck.org = rs.Fields(i - 1).Name 
Next 
ws.Range("A2").CopyFromRecordset rs 
rs.Close 
cnn.Close 
Set rs = Nothing 
Set cnn = Nothing 
Call AddHeader 
Call FindBlankCells 
Call TableBorderSet 
ws.Columns(1).AutoFit 
ws.Cells(2, 1).Select 
MsgBox "Finished." 
End Sub 
‘ 在表格第一行插入行，然后合并单元格，加上说明文字 
Sub AddHeader() 
Dim ws As Worksheet 
Dim s1, s2 As String 
shCount = ActiveWorkbook.Sheets.Count 
Set ws = Sheets(shCount) 
Column = ws.UsedRange.Columns.Count 
ws.Rows(1).Insert 
s1 = Chr(Asc("A") + Column - 1) 
s2 = "A1:" & s1 & "1" 
ws.Range(s2).Merge 
ws.Rows(1).RowHeight = 100 
s1 = "说明" & Chr(13) & Chr(10) & _ 
"本总表为计算生成，把几个单科的客观题成绩合并在一起，避免手工处理时因考号不对齐而导致错位。" & Chr(13) & Chr(10) & _ 
"注意：如果某单科成绩表中存在相同考号，则总表中该考号的该科成绩是不准确的。" & Chr(13) & Chr(10) & _ 
"填涂错误的考号，一般出现在表里顶端或底端" 
ws.Cells(1, 1) = s1 
ActiveSheet.Rows(1).RowHeight = 80 
‘ 冻结窗格 
ActiveSheet.Rows(3).Select 
ActiveWindow.FreezePanes = True 
ActiveWindow.SmallScroll Down:=0 
End Sub 
‘ 设置表格边框 
Sub TableBorderSet() 
ActiveSheet.UsedRange.Select 
Selection.Borders(xlDiagonalDown).LineStyle = xlNone 
Selection.Borders(xlDiagonalUp).LineStyle = xlNone 
With Selection.Borders(xlEdgeLeft) 
.LineStyle = xlContinuous 
.Weight = xlThin 
.ColorIndex = xlAutomatic 
End With 
With Selection.Borders(xlEdgeTop) 
.LineStyle = xlContinuous 
.Weight = xlThin 
.ColorIndex = xlAutomatic 
End With 
With Selection.Borders(xlEdgeBottom) 
.LineStyle = xlContinuous 
.Weight = xlThin 
.ColorIndex = xlAutomatic 
End With 
With Selection.Borders(xlEdgeRight) 
.LineStyle = xlContinuous 
.Weight = xlThin 
.ColorIndex = xlAutomatic 
End With 
With Selection.Borders(xlInsideVertical) 
.LineStyle = xlContinuous 
.Weight = xlThin 
.ColorIndex = xlAutomatic 
End With 
With Selection.Borders(xlInsideHorizontal) 
.LineStyle = xlContinuous 
.Weight = xlThin 
.ColorIndex = xlAutomatic 
End With 
End Sub 
‘ 标记无分数的单元格，方便找出答题卡没有分数的学生 
Sub FindBlankCells() 
Dim i, j, row, col As Integer 
‘ActiveSheet.Cells(2, 1).Interior.ColorIndex = 15 
row = ActiveSheet.UsedRange.Rows.Count 
col = ActiveSheet.UsedRange.Columns.Count 
For i = 2 To row 
For j = 2 To col 
If IsEmpty(ActiveSheet.Cells(i, j).Value) Then 
ActiveSheet.Cells(i, j).Interior.ColorIndex = 15 
End If 
Next 
Next 
End Sub