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