2017-5-17

标签：分配   selection   .text   end   fse   通过   加油   不同的   table   

分享一个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

标签：分配   selection   .text   end   fse   通过   加油   不同的   table   

原文地址：http://www.cnblogs.com/supvol/p/6871765.html