使用For循环添加命名工作表

Question

我正在尝试编写一个代码,该代码将获取标题/名称列表,并为每个标题/名称创建一个选项卡,每个工作表都有一个列表中的名称.例如,给定ActiveSheet上的表(可能不一定是sheet1)

Metric | Comments | Title
   1   | testing1 | This is Metric1
   2   | testing2 | This is Metric2

我想在ActiveSheet之后添加2个工作表,分别名称为"This is Metric1"和"This is Metric2"(理想情况下,我想用"testing1"填充每个新工作表的单元格A1和"在我们可以运行之前,分别进行测试2".我仍然是VBA的新手,所以请用我的错误代码 - 这是我到目前为止所尝试的:

Sub test_tableTOtabs()
Dim fr As Integer
Dim lr As Integer
Dim col As String

fr = Application.InputBox("Starting row of data: ", , 2)
lr = Application.InputBox("Last row of data: ")
col = Application.InputBox("Column for Tab titles: ")

Dim BaseSheet As Worksheet
Set BaseSheet = ActiveSheet

Dim i As Integer
Dim TitleCell As String
Dim title As String
Dim ws As Worksheet

    For i = fr To lr
        Set TitleCell = col & CStr(i)
        title = ActiveSheet.Range("TitleCell").Value
        Set ws = Sheets.Add(After:=Sheets(Worksheets.Count))
            ws.Name = title
        Worksheets(BaseSheet).Activate
    Next

End Sub

我知道我可能过于复杂了,但我不确定如何完成这项工作 - 请帮忙!

Answer 1

你的代码有两个主要(和相反的!)缺陷

1. 使用string带有变量名称的a而不是变量本身

   title = ActiveSheet.Range("TitleCell").Value
   

   应该

   title = ActiveSheet.Range(TitleCell).Value
   

   因为"TitleCell"它只是一个字符串,TitleCell而是对以"TitleCell"命名的变量的引用

2. 使用变量而不是string变量本身的名称

   Worksheets(BaseSheet).Activate
   

   应该

   • 或

     Worksheets(BaseSheet.Name).Activate
     

     因为Worksheets需要一个带有工作表名称的字符串来引用

   • 要么

     BaseSheet.Activate
     

     因为BaseSheet已经是工作表对象引用本身

然后是一些小缺陷

• 同

  Set ws = Sheets.Add(After:=Sheets(Worksheets.Count))
  

  您最有可能想在工作簿的末尾添加新工作表

  然后你必须使用

  Set ws = Sheets.Add(After:=Sheets(Sheets.Count))
  

  因为Worksheets.Count计算Worksheets集合中的项目,不包括任何Chart对象

  而Sheets.Count对在该项目Sheets的集合,其中包括Worksheet与Chart对象

• 弱用 Application.InputBox()

  同

  fr = Application.InputBox("Starting row of data: ", , 2)
  lr = Application.InputBox("Last row of data: ")
  col = Application.InputBox("Column for Tab titles: ")
  

  您没有使用非常方便的功能Application.InputBox()功能,可以指定Type用户必须输入的值

  所以你最好用

  fr = Application.InputBox("Starting row of data: ", Default:=2, Type:=1)' force a "numeric" user input 
  lr = Application.InputBox("Last row of data: ", , Default:=2, Type:=1)' force a "numeric" user input 
  col = Application.InputBox("Column for Tab titles: ", Default:="C", Type:=2)' force a "string" user input 
  

  后者对于随后使用的代码非常重要

   TitleCell = col & CStr(i)
   title = ActiveSheet.Range(TitleCell).value
  

  即它假设这col是一个字符串列索引而不是数字索引

• 使用Activate/Active/Select/Selection编码模式

  这被认为是不好的做法,你应该使用完全合格的范围引用来完全控制你的代码正在做什么(当代码变得更长时间和/或你让用户做的时候很容易丢失实际的"活动"表一些表格切换 - 与之相似Application.InputBox())并提高代码效率(无屏幕闪烁)

所以你可以考虑下面的代码重构(注释中的解释)

Sub test_tableTOtabs()
    Dim fr As Long, lr As Long
    Dim col As String
    Dim cell As Range

    fr = Application.InputBox("Starting row of data: ", Default:=2, Type:=1) 'force "numeric" user input
    With Worksheets("myBaseSheetName") ' reference your "base" sheet (change "myBaseSheetName" with the name of your actual "base" sheet)

        lr = Application.InputBox("Last row of data: ", , Default:=.Cells(.Rows.Count, 1).End(xlUp).Row, Type:=1) 'force "numeric" user input and give him referenced sheet column A last not empty row indeex as default
        col = Application.InputBox("Column for Tab titles: ", Default:=Split(Cells(1, Columns.Count).End(xlToLeft).Address, "$")(1), Type:=2) 'force "string" user input and give him referenced sheet row 1 last not empty column name as default

        For Each cell In Intersect(.Range(col & ":" & col), .Rows(fr & ":" & lr)) ' loop through referenced sheet column 'col' rows from 'fr' to 'lr'
            With Sheets.Add(After:=Sheets(Sheets.Count)) ' add and reference a new sheet at the end of the workbook
                .Name = cell.value ' rename referenced sheet after current cell value
                .Range("A1").value = cell.Offset(, -1) ' fill referenced sheet cell A1 with the content of the cell one column right of the current one
            End With
        Next
    End With
End Sub