PDA

View Full Version : cách lấy đường link trong file excel



hnam
09-01-08, 03:47 PM
Mình có danh sách khách hàng, tên của khách hàng là 1 hyperlink chỉ tới 1 trang web về thông tin cá nhân, giờ mình muốn lấy đường link này ra, nếu mở từng cái để copy thì nhiều quá vì danh sách đã quá dài -+*/ , ai có cách lấy nhanh chóng chỉ mình với (mình muốn tạo thêm 1 cột nữa để lấy link ra). Thanks--=0

anhtuan1066
09-01-08, 09:22 PM
Bạn dùng thử hàm tự tạo này xem (sưu tầm)


Function HyperLinkText(pRange As Range) As String
Dim ST1 As String
Dim ST2 As String
If pRange.Hyperlinks.Count = 0 Then
Exit Function
End If
ST1 = pRange.Hyperlinks(1).Address
ST2 = pRange.Hyperlinks(1).SubAddress
If ST2 <> "" Then
ST1 = "[" & ST1 & "]" & ST2
End If
HyperLinkText = ST1
End Function
Mến
ANH TUẤN

DOSNET
10-01-08, 08:29 AM
Hay lắm, Chỗ này mục đích làm việc gì em chưa hiểu...


If ST2 <> "" Then
ST1 = "[" & ST1 & "]" & ST2

tigertiger
10-01-08, 09:29 AM
Rất hay,
Sửa lại một chút cho nó ngắn, không cần End If nữa:



Function HyperLinkText(pRange As Range) As String
Dim ST1 As String
Dim ST2 As String
If pRange.Hyperlinks.Count = 0 Then Exit Function
ST1 = pRange.Hyperlinks(1).Address
ST2 = pRange.Hyperlinks(1).SubAddress
If ST2 <> "" Then ST1 = "[" & ST1 & "]" & ST2
HyperLinkText = ST1
End Function

nvson
20-03-08, 08:59 AM
Hay lắm, Chỗ này mục đích làm việc gì em chưa hiểu...


If ST2 <> "" Then
ST1 = "[" & ST1 & "]" & ST2


Theo mình hiểu thì thế này:
.SubAddress: là các Bookmark (các ô, các names)

.Address : là 1 địa chỉ, có thể là một địa chỉ Email, 1 địa chỉ trang web hay là 1 địa chỉ đến file nào đó...

Để dễ hình dung các bạn làm 1 thí nghiệm như sau:
- Tạo 1 file mới rồi tạo 1 Name (GPE chẳng hạn). Ghi lại và đóng file (D:\thu.xls).
- Tạo thêm 1 file Excel mới:
Tại ô bất kỳ, nhấn Ctrl+K để Insert HyperLink.
Chọn Existing File or Web Page, chọn tiếp đến file vừa ghi (thu.xls) lúc này trong ô Address có chữ thu.xls, nhấn tiếp vào nút Bookmark rồi chọn đến Name mà mình đã đặt.
Nhấn OK để đóng các hộp thoại.
Tiép tục Insert đoạn code của bác anhtuan1066 vào và thực hiện lệnh HyperLinkText, kết quả sẽ là [thu.xls]GPE
Như vậy ST1 = thu.xls
ST2 = GPE

P/S: Với bài toán của bạn hnam thì chỉ cần lấy thông số Address thôi.

Thien
20-03-08, 09:10 AM
Hi!
Mình hay dùng code này để liệt kê toàn bộ các link trong file hiện hành


Sub ListExternalFormulaReferences()
Dim ws As Worksheet, TargetWS As Worksheet, SourceWb As Workbook
If ActiveWorkbook Is Nothing Then Exit Sub
Application.ScreenUpdating = False
With ActiveWorkbook
On Error Resume Next
Set TargetWS = .Worksheets.Add(Before:=.Worksheets(1))
If TargetWS Is Nothing Then ' the workbook is protected
Set SourceWb = ActiveWorkbook
Set TargetWS = Workbooks.Add.Worksheets(1)
SourceWb.Activate
Set SourceWb = Nothing
End If
With TargetWS
.Range("A1").Formula = "Sequence"
.Range("B1").Formula = "Cell"
.Range("C1").Formula = "Formula"
.Range("A1:C1").Font.Bold = True
End With
For Each ws In .Worksheets
If Not ws Is TargetWS Then
ListLinksInWS ws, TargetWS
End If
Next ws
Set ws = Nothing
End With
With TargetWS
.Parent.Activate
.Activate
.Columns("A:C").AutoFit
On Error Resume Next
.Name = "Link List"
On Error GoTo 0
End With
Set TargetWS = Nothing
Application.ScreenUpdating = True
End Sub
Private Sub ListLinksInWS(ws As Worksheet, TargetWS As Worksheet)
Dim cl As Range, cFormula As String, tRow As Long
If ws Is Nothing Then Exit Sub
If TargetWS Is Nothing Then Exit Sub
Application.StatusBar = "Finding external formula references in " & _
ws.Name & "..."
For Each cl In ws.UsedRange
cFormula = cl.Formula
If Len(cFormula) > 0 Then
If Left$(cFormula, 1) = "=" Then
If InStr(cFormula, "[") > 1 Then
With TargetWS
tRow = .Range("A" & .Rows.Count).End(xlUp).Row + 1
.Range("A" & tRow).Formula = tRow - 1
.Range("B" & tRow).Formula = ws.Name & "!" & _
cl.Address(False, False, xlA1)
.Range("C" & tRow).Formula = "'" & cFormula
End With
End If
End If
End If
Next cl
Set cl = Nothing
Application.StatusBar = False
End Sub
Sub ListLinks()
Dim aLinks As Variant
aLinks = ActiveWorkbook.LinkSources(xlExcelLinks)
If Not IsEmpty(aLinks) Then
Sheets.Add
For i = 1 To UBound(aLinks)
Cells(i, 1).Value = aLinks(i)
Next i
End If
End Sub

Sưu tầm à nhen.

Thân


P/s: xin lỗi nhen mình chẳn hiểu sao lại bị cắt bớt code nữa.

nvson
20-03-08, 01:14 PM
To Thien:
Bạn kiểm tra lại đoạn code trên nhé!
Chắc là thiếu rồi.