首页 > 代码库 > 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