Làm việc với Name trong Excel

Unknown 02:04 Leave a Comment
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
    '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


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
  
    '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



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
    '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



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
    '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


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
'   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



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
  
       ' 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


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
Trích nguồn từ : http://www.giaiphapexcel.com/forum/content.php?206-S%E1%BB%AD-d%E1%BB%A5ng-Name-trong-VBA

0 nhận xét:

Đăng nhận xét

Copyright © 2014 • Chia sẻ kiến thức học tập

Thông tin tác giả Xin đừng nhấn vào đây.