Dim i As Long, Leng As Long, rEnd As Long, m As Long
Dim Ktu As String, Gtri As String
On Error Resume Next
rEnd = [b100000].End(xlUp).Row
Leng = Len([a1])
If Leng > 6 Then
For i = 1 To Leng
Ktu = Right(Left([a1], i), 1)
If Ktu = ":" Then
m = i + 1
Exit For
End If
Next i
If m > 0 Then
Gtri = Left(Right([a1], Leng - m), Leng - m - 5)
For i = 8 To rEnd
If Cells(i, 1).Value = Gtri Then
Cells(i, 1).Select
Exit Sub
End If
Next i
End If
End If
tại mình làm gấp quá để tranh thủ đi làm, mình text trên máy của mình thì không thấy bị lỗi, còn phần "Back to Index" thì nó cũng giống tương tự như thằng hyperlink thôi, nếu bạn đợi được tới ngày mai mình mới gửi file update lên cho bạn nha!Dạ. gần đúng rồi ạ.
nhưng cần chỉnh lại cho đẹp như sau, vì khi chạy button "Hyperlink" trong sheet "Index", title không hiện lên được tương ứng title từng table sheet "Table".
[TABLE="width: 446"]
[TR]
[TD="colspan: 3"]#TABLE INDEX#[/TD]
[/TR]
[TR]
[TD]Table No[/TD]
[TD]Table Title[/TD]
[TD]Base[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]#TABLE INDEX#[/TD]
[TD]232[/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]Table!A41[/TD]
[TD]232[/TD]
[/TR]
[TR]
[TD]3[/TD]
[TD]Table!A99[/TD]
[TD]200[/TD]
[/TR]
[TR]
[TD]4[/TD]
[TD]Table!A147[/TD]
[TD]215[/TD]
[/TR]
[/TABLE]
-> phải như vầy thì hay quá:
[TABLE="width: 446"]
[TR]
[TD="colspan: 3"]#TABLE INDEX#[/TD]
[/TR]
[TR]
[TD]Table No[/TD]
[TD]Table Title[/TD]
[TD]Base[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD] X3: ques1[/TD]
[TD]232[/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]X4: Ques Temp 1[/TD]
[TD]150[/TD]
[/TR]
[TR]
[TD]3[/TD]
[TD]X5: Ques Temp 5[/TD]
[TD]200[/TD]
[/TR]
[TR]
[TD]4[/TD]
[TD]Ques Total[/TD]
[TD]215[/TD]
[/TR]
[/TABLE]
Và thay vì button "Back to Index" trên đầu sheet "Table" thì có thể chỉnh lại thành text "Back To Index" dưới mỗi table
Vì dụ: text "Back To Index" ở ô A4, A44, A102, A105
Cám ơn anh và mọi người vì đã dành thời gian giúp mình nhé![]()
[TABLE="width: 408"]
[TR]
[TD="width: 408"]Cell Contents: <BR/>- Count<BR/ColumnPercentage<BR/>[/TD]
[/TR]
[/TABLE]
Private Sub CommandButton1_Click()Dim i As Long, Leng As Long, rEnd As Long, m As Long, n As Long, k As Long
Dim Ktu As String, Gtri As String
On Error Resume Next
rEnd = Sheet2.[a100000].End(xlUp).Row
Sheet1.[a3].Resize(10000, 3).Clear
For n = 1 To rEnd
[COLOR=#ff0000] If Len(Sheet2.Cells(n, 1)) > 6 And Right(Sheet2.Cells(n, 1), 5) = "<BR/>" Then[/COLOR]
Leng = Len(Sheet2.Cells(n, 1))
If Leng > 6 Then
For i = 1 To Leng
m = 0
Ktu = Right(Left(Sheet2.Cells(n, 1), i), 1)
[COLOR=#ff0000] If Ktu = ":" Then[/COLOR]
m = i + 1
If m > 0 Then
k = k + 1
Gtri = Left(Right(Sheet2.Cells(n, 1), Leng - m), Leng - m - 5)
With Sheet1
.Cells(k + 2, 1) = k
.Cells(k + 2, 2) = Gtri
.Cells(k + 2, 2).Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:= _
"Table!A" & n & "", TextToDisplay:="" & Gtri & ""
.Cells(k + 2, 3) = Sheet2.Cells(n + 6, 2)
End With
End If
Exit For
End If
Next i
End If
End If
Next n
If k > 0 Then
rEnd = Sheet1.[b100000].End(xlUp).Row
With Sheet1.Range("a3:c" & rEnd)
.Borders.LineStyle = 1
.VerticalAlignment = xlCenter
.HorizontalAlignment = xlCenter
End With
End If
End Sub