**一EXCEL檔案於G欄有此檔案的所有工作表名稱
要一一開啟執行相同作業
若此工作表不存在
需新增此工作表於最後
試寫了一段
但不知如何寫判斷式
敬請各位大大幫忙
Sub 開工作表() '工作表名稱 為 文字 若無此工作表 要新增於最後
Worksheets("AA").Select
Rcnt = Range("G6").End(xlDown).Row '工作表名稱放於 G7 以下
For i = 7 To Rcnt
ShtN = Worksheets("AA").Range("G" & i).Value
檢查有無此名稱之工作表
若 有
Worksheets(ShtN).Select
'other programs
若 無
Worksheets.Add '要新增於最後
ActiveSheet.Name = ShtN
'other programs
Next i
End Sub
**
Sub check_sht_names()
dim shtNames as string, shtArray as variant
dim sht as worksheet, pos as variant
' get all names of worksheets
for each sht in worksheets
shtNames = shtNames & "/" & sht.name
next sht
shtNames = Mid(shtNames, 2)
' make a list of worksheet names
shtArray = Split(shtNames, "/")
Rcnt = Worksheets("AA").Range("G6").End(xlDown).Row
For i = 7 To Rcnt
ShtN = Worksheets("AA").Range("G" & i).Value
pos = Application.Match(ShtN, shtArray, 0)
If IsError(pos) Then
With Worksheets.Add(after:=worksheets(worksheets.count))
.Name = ShtN
End With
end if
Next i
End Sub
對不起,我打太快了。
shtNames = "/" & sht.name
應該改為
shtNames = shtNames & "/" & sht.name
已經重新編輯過答案了。
另外,Match函數確實是不分大小寫的。
一般來說,微軟的產品(Windows, Office等)大多是case insensitive。
shtNames = shtNames & "/" & sht.name
shtNames = "/" & sht.Name & shtNames
2個都可以
差異為 一個 由前到後 及 另一個 由後到前
請問能否將 所有工作表名稱 直接 逐一 加入陣列(用Join或Item)
而無須先合併成一字串再一一分開成陣列
只是 Join 或 Item 都不太會用
shtNames = shtNames & "/" & sht.name
shtNames = "/" & sht.Name & shtNames
2個都可以
確實如此
請問能否將 所有工作表名稱 直接 逐一 加入陣列(用Join或Item)
而無須先合併成一字串再一一分開成陣列
可以,但要先宣告一個不定陣列,然後逐漸加上去。大概會類似
dim ary as variant, sht as worksheet
for each sht in worksheets
if isarray(ary) then
redim preserve ary(ubound(ary)+1) as variant
else
redim ary(0) as variant
end if
ary(ubound(ary)) = sht.name
next sht
感覺用ubound一直加大陣列 好像不是很有效率
(ubound 還沒用過...)
直接 Worksheets.Count(cnt) 再加 ReDim陣列(1 to cnt)
再用 for(1 to cnt) next... 將現有每一工作表名稱加入陣列
如此是否會比較有效率(當現有工作表很多(50~60)時)
當然可以。
可能會更好吧。(我沒有測試過)
Private Function WorksheetExists(ByVal WorksheetName As String) As Boolean
'PURPOSE: Determine if a worksheet name exists in the workbook
'SOURCE: www.TheSpreadsheetGuru.com/the-code-vault
On Error Resume Next
WorksheetExists = (ActiveWorkbook.Sheets(WorksheetName).Name <> "")
On Error GoTo 0
End Function