Question

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

我希望宏观行动：

如果工作表名称与数组值匹配，则不执行任何操作
如果没有数组值的工作表名称，请添加工作表并将其命名为数组值
如果阵列中不存在工作表，请删除工作表。

我可以使用值填充数组，但是我很难根据数组值添加/删除工作表。我注意到我的代码卡在了我的位置。

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

Answer 1

未测试：

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

Answer 2

您可以运行两个单独的循环。一个循环添加工作表。删除工作表的一个循环：

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

Answer 3

试试这个功能。它完全符合您的需求。

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

根据数组值添加或删除Excel表格

3 个答案: