基于数组值添加或删除Excel表格

我正在处理一段代码,它创build一个数组并根据Excel工作表中一列的内容来填充它。 然后我想使用这个数组添加或删除Excel表格。

操作我希望macros执行:

  1. 如果表格名称与数组值相匹配,则什么也不做
  2. 如果数组值没有表单名称,请添加一个表单并将其命名为数组值
  3. 如果数组中不存在工作表,请删除工作表。

我可以使用值填充数组,但是我很难根据数组值添加/删除工作表。 我注意到我困在我的代码中的地方。

Sub CheckCities() 'Declare Variable Dim rngCities As Range Dim rngCityName As Range Dim ws As Worksheet Dim arrCityName() As String Dim counter As Integer Dim intWsCount As Integer 'Reset and erase array at start of program. Allows for proper data in array Erase arrCityName 'initialize counter variable counter = 0 'Set Range Name for wsData Customers With wsAllCities1.Range("A2") Set rngCities = Range(.Offset(0, 0), .End(xlDown)) End With '''''''''''''''''''''''''''''''''''''''''''' ' For Loop through Each City in rngCities ' adds current rngCities cell value to array '''''''''''''''''''''''''''''''''''''''''''' For Each rngCityName In rngCities.Cells 'Debug.Print rngCityName.Value ' Print the values of each cell counter = counter + 1 'Step up counter variable by 1 ReDim Preserve arrCityName(0 To rngCities.Count) arrCityName(counter) = rngCityName.Value 'use the counter variable to create Array(#) Next rngCityName ''''''''''''''''''''''''''''''''''''''''''''''''''' 'Test to verify Array was populated with City Names ''''''''''''''''''''''''''''''''''''''''''''''''''' 'wsAllCities1.Range("E2").Value = arrCityName(0) 'wsAllCities1.Range("E3").Value = arrCityName(1) 'wsAllCities1.Range("E4").Value = arrCityName(2) 'wsAllCities1.Range("E5").Value = arrCityName(3) 'wsAllCities1.Range("E6").Value = arrCityName(4) 'wsAllCities1.Range("E7").Value = arrCityName(5) 'wsAllCities1.Range("E8").Value = arrCityName(6) 'wsAllCities1.Range("E9").Value = arrCityName(7) 'wsAllCities1.Range("E10").Value = arrCityName(8) 'wsAllCities1.Range("E11").Value = arrCityName(9) '''''''''''''''''''''''''''''''''''''''''''' ' Loop statement to check sheet names ' adds or deletes sheets via arrCityName values '''''''''''''''''''''''''''''''''''''''''''' ''''STUCK ON CODE BELOW'''''''''''''''' ''''STUCK ON CODE BELOW'''''''''''''''' ''''STUCK ON CODE BELOW'''''''''''''''' ''''STUCK ON CODE BELOW'''''''''''''''' ''''STUCK ON CODE BELOW'''''''''''''''' ''''STUCK ON CODE BELOW'''''''''''''''' intWsCount = ThisWorkbook.Worksheets.Count 'Count Number of Worksheets in this workbook For Each ws In ThisWorkbook.Worksheets counter = 0 'set variable Do ws.Activate 'activate the next worksheet in the look If ws.Name <> "AllCities" Then For Each arrayItem In arrCityName If arrCityName = ws.Name Then Debug.Print "City Name Found!" ElseIf arrCityName <> ws.Name Then End If Next Debug.Print "This city, " & ws.Name & ", does not exist in city list" End If Loop Until intWsCount 'Loop (x) number of times. X is determinted by variable intWsCount Next End Sub 

你可以运行两个独立的循环。 一个循环来添加工作表。 一个循环删除工作表:

 Sub dural() Dim DesiredSheets(1 To 3) As String Dim KillIt As Boolean, AddIt As Boolean DesiredSheets(1) = "Sheet1" DesiredSheets(2) = "Sheet2" DesiredSheets(3) = "Whatever" For Each sh In Sheets KillIt = True v = sh.Name For Each a In DesiredSheets If v = a Then KillIt = False End If Next a If KillIt Then sh.Delete Next sh For Each a In DesiredSheets AddIt = True For Each sh In Sheets If a = sh.Name Then AddIt = False End If Next sh If AddIt Then Sheets.Add ActiveSheet.Name = a End If Next a End Sub 

未经testing:

 Sub CheckCities() 'Declare Variable Dim rngCities As Range Dim rngCityName As Range Dim ws As Worksheet Dim arrCityName() As String Dim counter As long Dim x as long, nm as string With wsAllCities1 Set rngCities = .Range(.Range("A2").Offset(0, 0), _ .Range("A2").End(xlDown)) End With ReDim Preserve arrCityName(1 To rngCities.Cells.Count) counter=0 For Each rngCityName In rngCities.Cells counter = counter + 1 arrCityName(counter) = rngCityName.Value Next rngCityName for x=1 to counter nm = arrCityName(x) set ws = nothing on error resume next 'ignore error if no sheet found set ws = thisworkbook.sheets(nm) on error goto 0 'stop ignoring errors if ws is nothing then set ws = thisworkbook.worksheets.add() ws.Name = nm debug.print "Added sheet '" & nm & "'" else debug.print "Sheet '" & nm & "' already exists" end if next x End Sub 

试试这个function。 它正是你所需要的。

 Public Function Test() Dim wks, xlWSH As Worksheet Dim myRange, Cell As Range Dim ProtectIt As Boolean 'Refer to sheet name where you save your sheet names list Set wks = Worksheets("SheetName") With wks 'Refer to first cell where your sheet names list starts. Here is "A1" Set myRange = .Range(.Cells(1, "A"), .Cells(.Rows.Count, "A").End(xlUp)) End With For Each xlWSH In ActiveWorkbook.Worksheets For Each Cell In myRange 'If sheet name is in your list then set DoIt to False If xlWSH.Name = Cell.Value Then DoIt = False Exit For Else DoIt = True End If Next Cell If DoIt = True Then With xlWSH 'Do Some Actions With Sheet End With End If Next xlWSH End Function