首页 > 代码库 > 2017-5-17

2017-5-17

分享一个VBA的一个把一个sheet中的多个table(每一个table又hyperlinks),分配在不同的sheet中的方法,做这个真的也是耗费了不少的脑细胞。

Option Explicit   ’这个是一个好习惯

 

’第一种方法,通过currentregion来判断区域,但是不是很保险

Sub GetHplin()

Dim arr(21) As Variant     ‘现在还不是很明白vba中的数组是怎么存放的

Dim i, n As Integer

    With Worksheets("Sheet1")

        For i = 7 To 21 Step 2

        arr(i) = .Range("A" & i).Hyperlinks(1).SubAddress

    Sheets.Add after:=Sheets(Sheets.Count)

        Sheets(Sheets.Count).Name = Left(.Range(arr(i)).Text, 7)

        Worksheets("Sheet1").Activate

        Worksheets("Sheet1").Range(arr(i)).Offset(1, 0).CurrentRegion.Select

        Selection.Copy Destination:=Sheets(Sheets(Sheets.Count).Name).Range("A1")

        Next i

    End With

End Sub

 

 

‘第二种方法,根据上下的行数来判断

Sub example()

    Dim lastTableEndRow As Range

    Dim currentTableFirstRow As Range, currentTableLastRow As Range

    Dim iRow As Long 

    With Worksheets("Sheet1")

        Set lastTableEndRow = .Cells(Cells.Rows.Count, 1).End(xlUp)

        For iRow = 7 To 21 Step 2

            Set currentTableFirstRow = Range(.Cells(iRow, 1).Hyperlinks(1).SubAddress)

            If iRow = 21 Then

                Set currentTableLastRow = lastTableEndRow

            Else

                Set currentTableLastRow = Range(.Cells(iRow + 2, 1).Hyperlinks(1).SubAddress).Offset(-1, 0)                 

            End If   

            Debug.Print currentTableFirstRow.Address; currentTableLastRow.Address

        Next iRow     

    End With

End Sub

 

 

不知道这种觉得自己能力很差,一边学习,一边实习的时间还有多久过去,总之,已经很幸运可以做自己喜欢的事情。

 

Anyway,加油吧!!!

2017-5-17