排序数组大小

时间:2018-04-19 09:46:59

标签: excel vba excel-vba

我正在尝试使用visual basic在目录上创建各种工作表的超链接。

第一张是目录。因此,要包含在目录中的工作表从工作表2开始。我无法将数组更改为从工作表2开始。

这些是我的代码行

'Create Table of Contents

 ' Create array with locations

    Set firstsheet = Worksheet(2).Value

    '  Dim arrworksheets(2 To Worksheets.Count) As Long

    For x = arr(firstsheet) To UBound(myArray)

    Set sht = Worksheets(myArray(x))

    sht.Activate

    With Content_sht

      .Hyperlinks.Add .Cells(x + 2, 3), "", _

      SubAddress:="'" & sht.Name & "'!A1", _

      TextToDisplay:=sht.Name

      .Cells(x + 2, 2).Value = x

    End With

  Next x

提前非常感谢你!

2 个答案:

答案 0 :(得分:0)

据我所知,您想要遍历工作簿中的所有工作表,但不包括列表中的第一个工作表 - 内容页面。

有一个很好的例子说明如何实现这个here,根据代码的相似性来判断,你可能已经看过了。{/ p>

您要查看的相关部分是:

'Create Array list with sheet names (excluding Contents)
  ReDim myArray(1 To Worksheets.Count - 1)

  For Each sht In ActiveWorkbook.Worksheets
    If sht.Name <> ContentName Then
      myArray(x + 1) = sht.Name
      x = x + 1
    End If
  Next sht

此处,它不会尝试根据工作簿中的顺序排除内容页面,而是根据工作表名称If sht.Name <> ContentName将其排除。

但是为了完整性,如果您仍然希望根据每个工作表所处的位置执行此操作,则可以简单地使用For循环而不是数组,并从2开始(请记住,工作表集合不是基于0的索引):

Dim x As Integer
Dim count As Integer
Dim Content_sht As Worksheet
Dim sht_nam As String

count = ActiveWorkbook.Worksheets.count
Set Content_sht = Worksheets("Sheet1") 'whatever your contents page is called


For x = 2 To count

    sht_nam = Worksheets(x).Name

    With Content_sht
      .Hyperlinks.Add .Cells(x + 2, 3), "", _
      SubAddress:="'" & sht_nam & "'!A1", _
      TextToDisplay:=sht_nam
      .Cells(x + 2, 2).Value = x
    End With

Next x

答案 1 :(得分:0)

试试这个

Option Explicit

Public Sub MakeTOC()    'Create Table of Contents
    Const TOC_COL = 3
    Const TOC_ROW = 5
    Dim wsTOC As Worksheet, ws As Worksheet, nextRow As Long, linkAddress As String

    Set wsTOC = ThisWorkbook.Worksheets("Sheet3")   'TOC Sheet

    With wsTOC.Cells(TOC_ROW - 2, TOC_COL)  'Set title cell
        .Value2 = "Table of Contents"
        .Font.Size = 14
        .Font.Bold = True
        .HorizontalAlignment = xlCenter
    End With

    nextRow = TOC_ROW

    For Each ws In ThisWorkbook.Worksheets  'Add list of Sheet Names
        If ws.Name <> wsTOC.Name Then
            linkAddress = "'" & ws.Name & "'!A1"
            With wsTOC.Cells(nextRow, TOC_COL)
                .Value2 = ws.Name
                .Hyperlinks.Add .Cells(1), vbNullString, SubAddress:=linkAddress, _
                                TextToDisplay:=ws.Name
                .Font.Bold = True
                .Offset(, -1) = nextRow - TOC_ROW + 1
                .Offset(, -1).HorizontalAlignment = xlCenter
            End With
            nextRow = nextRow + 1
        End If
    Next
    wsTOC.Columns(TOC_COL).Columns.AutoFit
    wsTOC.UsedRange.VerticalAlignment = xlCenter
End Sub

输出

Result