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.
1
2
3
4
5
6
7
8
9
|
Sub AddNewData()
Dim lRows As Long
With Range( "DanhSach" )
lRows = .Rows.Count + 1
Range( "TenThemVao" ).Copy Destination:=.Cells(lRows, 1)
.Resize(lRows).Name = "DanhSach"
End With
End Sub
|
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 collectionNames. 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:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
|
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
Application.Volatile
On Error Resume Next
Set rng = Application.Caller
Err.Clear
If rng Is Nothing Then
s = ActiveWorkbook.Names(sName).Name
Else
s = rng.Parent.Parent.Names(sName).Name
End If
If Err.Number = 0 Then IsNameInWorkbook = True
End Function
|
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:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
|
Sub SelectionEntirelyInNames()
Dim sMessage As String
Dim nmName As Name
Dim rngNameRange As Range
Dim rng As Range
On Error Resume Next
For Each nmName In Names
Set rngNameRange = Nothing
Set rngNameRange = nmName.RefersToRange
If Not rngNameRange Is Nothing Then
If rngNameRange.Parent.Name = ActiveSheet.Name Then
Set rng = Intersect(Selection, rngNameRange)
If Not rng Is Nothing Then
If Selection.Address = rng.Address Then
sMessage = sMessage & nmName.Name & vbCr
End If
End If
End If
End If
Next nmName
If sMessage = "" Then
MsgBox "Hai Name không giao nhau"
Else
MsgBox sMessage
End If
End Sub
|
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:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
|
Sub NamesOverlappingSelection()
Dim sMessage As String
Dim nmName As Name
Dim rngNameRange As Range
Dim rng As Range
On Error Resume Next
For Each nmName In Names
Set rngNameRange = Nothing
Set rngNameRange = Range(nmName.Name)
If Not rngNameRange Is Nothing Then
If rngNameRange.Parent.Name = ActiveSheet.Name Then
Set rng = Intersect(Selection, rngNameRange)
If Not rng Is Nothing Then
sMessage = sMessage & nmName.Name & vbCr
End If
End If
End If
Next nmName
If sMessage = "" Then
MsgBox "Vùng chọn không giao với Name nào"
Else
MsgBox sMessage
End If
End Sub
|
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:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
|
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
Dim x As Object
On Error Resume Next
Set x = ActiveWorkbook.Sheets(sname)
If Err = 0 Then SheetExists = True _
Else SheetExists = False
End Function
|
Xóa Name ẩn trong Workbook
Code tham khảo:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
|
Sub Remove_Hidden_Names()
Dim xName As Variant
Dim Result As Variant
Dim Vis As Variant
For Each xName In ActiveWorkbook.Names
If xName.Visible = True Then
Vis = "Nhin thay"
Else
Vis = "Bi an"
End If
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" )
If Result = vbYes Then xName.Delete
Next xName
End Sub
|
Xóa các Name bị lỗi tham chiếu
Code tham khảo:
1
2
3
4
5
6
7
8
|
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
|
Bài viết đến đây kết thúc.
Cách chia sẻ Excel qua mạng giải pháp làm việc nhóm hiệu quả nhất.
Trích nguồn : http://www.giaiphapexcel.com/forum/content.php?207-M%E1%BB%99t-s%E1%BB%91-h%C3%A0m-v%C3%A0-th%E1%BB%A7-t%E1%BB%A5c-l%C3%A0m-vi%E1%BB%87c-v%E1%BB%9Bi-Name-trong-VBA
0 nhận xét:
Đăng nhận xét