Bài viết: Một số hàm và thủ tục làm việc với Name trong VBA

[TranThanhPhong]

Tác giả: Lê Văn Duyệt

Mở rộng vùng đã được đặt tên

Giả sử chúng ta có các vùng đã được đặt tên như hình dưới. Bây giờ chúng ta muốn mở rộng DanhSach với dữ liệu của TenThemVao, các bạn có thể dùng thủ tục sau.

[GPECODE=vba]Sub AddNewData()
Dim lRows As Long
'Sao chép dữ liệu và mở rộng DanhSach them 1 hàng
With Range("DanhSach")
lRows = .Rows.Count + 1
Range("TenThemVao").Copy Destination:=.Cells(lRows, 1)
.Resize(lRows).Name = "DanhSach"
End With
End Sub[/GPECODE]

Sau khi chạy thủ tục trên các bạn sẽ được kết quả như hình bên. Tôi nghĩ đây là một cách hay, các bạn có thể tham khảo ví dụ trên mà áp dụng vào các ứng dụng của mình. Chúng ta sẽ có bài về đối tượng Range riêng.

Khi đặt tên các bạn chú ý về tên mình đặt như:

• Criteria, Database, Extract → Khi dùng tính năng Advanced Filter
• Print_Area → Thiết lập vùng in trong Page Setup
• Print_Titles → Thiết lập tựa đề in trong Page Setup
• TableX → Khi định dạng Range dạng Table

Trong Excel 2007+ các bạn để ý rằng có một số tên đặc biệt khi bạn dùng tính năng Table để quản lý danh sách dữ liệu. Mặc định Excel 2007 sẽ đặt tên các bảng là Table1, Table2,… Những tên này sẽ xuất hiện trong Name Manager nhưng không có trong collection Names. Chúng không thể xóa thủ công trong Name Manager, chúng ta dùng đối tượng ListObject để thao tác với chúng.

Tìm kiếm Name

Nếu chúng ta muốn kiểm tra xem tên có tồn tại hay không (cả trong Worksheet và VBA) các bạn có thể dùng đọan code sau:

[GPECODE=vba]Function IsNameInWorkbook(sName As String) As Boolean

‘Hàm được lấy từ Excel 2007 VBA Programmer Ref
Dim s As String
Dim rng As Range

'Xem tên có tồn tại trong workbook
'Bắt buộc recalculation nếu dùng worksheet function
Application.Volatile

'Bỏ qua lỗi
On Error Resume Next

'Cố gắng lấy tham chiểu đến cell mà hàm sử dụng
Set rng = Application.Caller
Err.Clear
If rng Is Nothing Then

'Hàm được gọi từ VBA
s = ActiveWorkbook.Names(sName).Name
Else

'Hàm được gọi từ cell
s = rng.Parent.Parent.Names(sName).Name
End If

'Nếu không có lỗi, tên tồn tại
If Err.Number = 0 Then IsNameInWorkbook = True
End Function[/GPECODE]


Kiểm tra hai Name có giao nhau hay không

Để xem hai tên có giao với nhau hay không, các bạn có thể dùng đọan code sau:

[GPECODE=vba]Sub SelectionEntirelyInNames()
Dim sMessage As String
Dim nmName As Name
Dim rngNameRange As Range
Dim rng As Range

On Error Resume Next

'Duyệt tất cả Name trong workbook
For Each nmName In Names

'Gán tham chiếu của Name cho biến
Set rngNameRange = Nothing
Set rngNameRange = nmName.RefersToRange

'Nếu thành công, chúng ta sẽ có Range tham chiếu
If Not rngNameRange Is Nothing Then

'Xem Range có trong Active Sheet hay không?
If rngNameRange.Parent.Name = ActiveSheet.Name Then

'Xem vùng chọn có trong range hay không
Set rng = Intersect(Selection, rngNameRange)
If Not rng Is Nothing Then

'Tạo câu thông báo khi hai Name giao nhau
If Selection.Address = rng.Address Then
sMessage = sMessage & nmName.Name & vbCr
End If
End If
End If
End If
Next nmName

'Thông báo
If sMessage = "" Then
MsgBox "Hai Name không giao nhau"
Else
MsgBox sMessage
End If
End Sub[/GPECODE]


Kiểm tra Range giao với Name

Nếu các bạn muốn xem các Range nào giao với vùng chúng ta đang chọn các bạn có thể dùng đọan mã sau:

[GPECODE=vba]Sub NamesOverlappingSelection()
Dim sMessage As String
Dim nmName As Name
Dim rngNameRange As Range
Dim rng As Range

On Error Resume Next

'Duyệt tất cả Name trong workbook
For Each nmName In Names

'Gán Name vào biến
Set rngNameRange = Nothing
Set rngNameRange = Range(nmName.Name)

If Not rngNameRange Is Nothing Then

'Kiểm tra vùng chọn có đang ở Sheet hiện hành không
If rngNameRange.Parent.Name = ActiveSheet.Name Then

'Tạo câu thông báo khi vùng chọn giao với Name
Set rng = Intersect(Selection, rngNameRange)
If Not rng Is Nothing Then
sMessage = sMessage & nmName.Name & vbCr
End If
End If
End If
Next nmName

'Hiện thông báo
If sMessage = "" Then
MsgBox "Vùng chọn không giao với Name nào"
Else
MsgBox sMessage
End If
End Sub[/GPECODE]

Chú ý hai thủ tục trên sử dụng hai kỹ thuật khác nhau để gán cho vùng tham chiếu (Range referred) bằng tên của biến đối tượng rngNameRange.

Set rngNameRange = nmName.RefersToRange
Set rngNameRange = Range(nmName.Name)


CÁC VÍ DỤ Bá»” SUNG

Liệt kê tất cả các Name trong workbook

Code tham khảo:

[GPECODE=vba]Sub ListAllNames()
Dim myName As Name
Dim intCount As Long

If SheetExists("Workbook names") Then
Sheets("Workbook names").Select
Cells.Select
Selection.Clear
Else
Application.Worksheets.Add
ActiveSheet.Name = "Workbook names"
End If

Range("A1") = "Names"
Range("B1") = "Reference"

With Range("A1:B1")
.Font.Bold = True
.Font.Underline = True
.Font.ColorIndex = 10
End With

intCount = 2

For Each myName In ThisWorkbook.Names

Range("A" & intCount).Value = myName.Name
Range("B" & intCount).Value = myName

intCount = intCount + 1
Next

Range("A1:B1").EntireColumn.AutoFit

End Sub


Function SheetExists(sname) As Boolean
' Trả về TRUE nếu Sheet tồn tại trong Workbook hiện hành
Dim x As Object
On Error Resume Next
Set x = ActiveWorkbook.Sheets(sname)
If Err = 0 Then SheetExists = True _
Else SheetExists = False
End Function[/GPECODE]


Xóa Name ẩn trong Workbook

Code tham khảo:

[GPECODE=vba] Sub Remove_Hidden_Names()
Dim xName As Variant
Dim Result As Variant
Dim Vis As Variant

' Duyệt qua các Name trong Workbook
For Each xName In ActiveWorkbook.Names
If xName.Visible = True Then
Vis = "Nhin thay"
Else
Vis = "Bi an"
End If

' ...hỏi người dùng xóa Name hay không?
Result = MsgBox(prompt:="Xoa Name " & Vis & " ten la: " & _
Chr(10) & xName.Name & "?" & Chr(10) & _
"Tham chieu den: " & Chr(10) & xName.RefersTo, _
Buttons:=vbYesNo + vbInformation + vbDefaultButton2, Title:="Thong bao")

' Nếu người dùng trả lời Yes sẽ xóa Name
If Result = vbYes Then xName.Delete

Next xName

End Sub[/GPECODE]


Xóa các Name bị lỗi tham chiếu

Code tham khảo:

[GPECODE=vba]Sub Xo_Name_Loi()
Dim nName As Name
For Each nName In Names
If InStr(1, nName.RefersTo, "#REF!") > 0 Then
nName.Delete
End If
Next nName
End Sub[/GPECODE]
http://www.giaiphapexcel.com/vbb/content.php?207