VBA嵌套的For循环以基于变量复制和重命名工作表;不起作用

huangapple go评论61阅读模式
英文:

VBA nested For Loop to copy and rename a worksheet based on a variable; not working

问题

I am trying to write a sub where I loop through a column full of dates, and for each tax year in the column create a copy of a template Worksheet and rename it to the tax year.

I've got part way. The loop for finding and returning the tax year for each cell works and loops through the full range. The loop for checking if there is already a worksheet named after that tax year works and loops through the full range.

The problem occurs once I combine the loops. The dates aren't in chronological order, so the first 23 dates are for 2023, and 1 Worksheet for 2023 is created, then there are 3 dates for 2022, and 1 worksheet for 2022 is created, then the next date is for 2023, and the For loop to check the existing sheet names fails, and it tries to create another worksheet for 2023, returning the Run-Time Error '1004': That name is already taken. Try a different one. I can't work out what I'm doing wrong. Any advice is greatly appreciated.

英文:

I am trying to write a sub where I loop through a column full of dates, and for each tax year in the column create a copy of a template Worksheet and rename it to the tax year.

I've got part way. The loop for finding and returning the tax year for each cell works and loops through the full range. The loop for checking if there is already a worksheet named after that tax year works and loops through the full range.

The problem occurs once I combine the loops. The dates aren't in chronological order so the first 23 dates are for 2023 and 1 Worksheet for 2023 is created, then there are 3 dates for for 2022 and 1 worksheet for 2022 is created, then the next date is for 2023 and the For loop to check the Exiting sheet names fails and it tries to create another worksheet for 2023 returning the Run Time Error '1004': That name is already taken. Try a different one. I can't work out what I'm doing wrong.

Any advice is greatly appreciated.

Option Explicit
Sub Createtaxyears()

'I'm teaching myself so apologies for poor layout/grammar with regards to my code.

Dim cell As Range
Dim Todate As Range

Dim Sort_Table As Worksheet
Dim Template As Worksheet
Dim WSheetfound As Boolean

Dim Template As Worksheet
Dim WSheet As Worksheet


Set Todate = Range("Sorttable[To Date]") 

Dim Tdate As String
Dim M As Variant
Dim I As Variant
Dim Y As Variant



Set Template = Sheets("Template")



Sheets("Sort_Table").Select  'selects source worksheet to start

For Each cell In Todate  'loop to find tax year

    If Not IsEmpty(cell) Then 'avoids runnin git on empty cells
    Tdate = cell.Value
    
    M = Split(Tdate, ".")  'dd.mm.yyyy is not recognised as a date need to use split to ref
        If M(1) >= 5 Then Y = M(2) + 1  ' tax year returns run from May to April
        If M(1) <= 4 Then Y = M(2)      'I'll turn this into a function later
    End If
    
    
    For Each WSheet In ThisWorkbook.Worksheets
       If WSheet.Name = Y Then
          WSheetfound = True
            
      Else
          WSheetfound = False
       End If

   Next WSheet
    
   
    If WSheetfound = False Then Template.Copy After:=Sheets(Sheets.Count)
    If WSheetfound = False Then Sheets(Sheets.Count).Select 'selects last sheet to prevent sort_table being renamed.
    If WSheetfound = False Then ActiveSheet.Name = (Y) 
   
    Next cell
  

End Sub

答案1

得分: 2

Consider using a dictionary object to determine if a sheet exists.

Option Explicit

Sub Createtaxyears()

    Dim wb As Workbook
    Dim wsTemplate As Worksheet, ws As Worksheet
    Dim rngToDate As Range, cell As Range, FY As String
    Dim arDMY, msg As String
    
    Set wb = ThisWorkbook
    Set rngToDate = wb.Sheets("Sort_Table").Range("Sorttable[To Date]")
    Set wsTemplate = wb.Sheets("Template")
    
    ' build dictionary of existing sheet names
    Dim dict As Object
    Set dict = CreateObject("Scripting.Dictionary")
    For Each ws In wb.Sheets
        dict.Add ws.Name, ws.Index
    Next
    
    'loop dates to find tax year
    For Each cell In rngToDate
         If cell Like "##.##.####" Then ' skip non date cells
            'dd.mm.yyyy is not recognised as a date need to use split to ref
            arDMY = Split(cell.Value, ".")
            If arDMY(1) >= 5 Then 'tax year returns run from May to April
                FY = CStr(arDMY(2) + 1)
            Else
                FY = CStr(arDMY(2))
            End If
        
            ' check if sheet doesn't exist
            If Not dict.exists(FY) Then
                wsTemplate.Copy After:=wb.Sheets(wb.Sheets.Count)
                wb.Sheets(wb.Sheets.Count).Name = FY
                dict.Add FY, 1
                msg = msg & vbLf & FY
            End If
        End If
    Next
    
    If msg = "" Then
        MsgBox "No sheets Added", vbInformation
    Else
        MsgBox "Sheets added for years" & msg, vbInformation
    End If
End Sub
英文:

Consider using a dictionary object to determine if a sheet exists.

Option Explicit

Sub Createtaxyears()

    Dim wb As Workbook
    Dim wsTemplate As Worksheet, ws As Worksheet
    Dim rngToDate As Range, cell As Range, FY As String
    Dim arDMY, msg As String
    
    Set wb = ThisWorkbook
    Set rngToDate = wb.Sheets("Sort_Table").Range("Sorttable[To Date]")
    Set wsTemplate = wb.Sheets("Template")
    
    ' build dictionary of existing sheet names
    Dim dict As Object
    Set dict = CreateObject("Scripting.Dictionary")
    For Each ws In wb.Sheets
        dict.Add ws.Name, ws.Index
    Next
    
    'loop dates to find tax year
    For Each cell In rngToDate
         If cell Like "##.##.####" Then ' skip non date cells
            'dd.mm.yyyy is not recognised as a date need to use split to ref
            arDMY = Split(cell.Value, ".")
            If arDMY(1) >= 5 Then 'tax year returns run from May to April
                FY = CStr(arDMY(2) + 1)
            Else
                FY = CStr(arDMY(2))
            End If
        
            ' check if sheet doesn't exist
            If Not dict.exists(FY) Then
                wsTemplate.Copy After:=wb.Sheets(wb.Sheets.Count)
                wb.Sheets(wb.Sheets.Count).Name = FY
                dict.Add FY, 1
                msg = msg & vbLf & FY
            End If
        End If
    Next
    
    If msg = "" Then
        MsgBox "No sheets Added", vbInformation
    Else
        MsgBox "Sheets added for years" & msg, vbInformation
    End If
End Sub

</details>



huangapple
  • 本文由 发表于 2023年6月29日 23:21:11
  • 转载请务必保留本文链接:https://go.coder-hub.com/76582456.html
匿名

发表评论

匿名网友

:?: :razz: :sad: :evil: :!: :smile: :oops: :grin: :eek: :shock: :???: :cool: :lol: :mad: :twisted: :roll: :wink: :idea: :arrow: :neutral: :cry: :mrgreen:

确定