HỎi cách lấy giá trị tham chiếu như file này

Liên hệ QC
File gì có vài dòng dữ liệu mà nặng lặt lè thế không biết?!

Vậy nên bạn thực hiện thử theo mình như sau:

Đến ô [AA1] & nhập vô đó cụm "GPE.COM"

(Lấy chuột) tô chọn 9 ô dưới nó & gán cho chúng 1 cái tên "GPE_"
(Có thể tô màu nền xanh nhạt cho 9 ô này nếu muốn)

Bước tiếp: Gán tên 'BTra' cho vùng [N4:P99] của trang tính

Tiếp theo bạn fải chuột vô tên trang tính & chọn dòng 'View Code' (E2007) & dán macro sự kiện này vô CS VBA vừa xuất hiện:

PHP:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
 If Not Intersect(Target, [e5:E99]) Is Nothing Then
    Dim Rng As Range, sRng As Range
    Dim MyAdd As String
    Dim W As Long
    ReDim Arr(1 To 9, 1 To 1) As String
    On Error Resume Next
    If Target.Offset(, 1).Value = "" Then
        MsgBox "Ban Chua Có Só Lieu!", , "GPE.COM Xin Chào!"
        Exit Sub
    End If
    Set Rng = Range("BTra")
    Set Rng = Rng(3).Resize(Rng.Rows.Count)
    Set sRng = Rng.Find(Target.Offset(, 1).Value, , xlFormulas, xlWhole)
    If Not sRng Is Nothing Then
        MyAdd = sRng.Address
        Do
            W = W + 1
            Arr(W, 1) = sRng.Offset(, -2).Value
            Set sRng = Rng.FindNext(sRng)
        Loop While Not sRng Is Nothing And sRng.Address <> MyAdd
    End If
    [AA2].Resize(9).Value = Arr()    
    GPE
 End If
End Sub

Tiếp nữa, bạn dán macro này vô module1:
Mã:
Sub GPE()
 With Selection.Validation
    .Delete
    .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=GPE_"
    .IgnoreBlank = True:            .InCellDropdown = True
    .InputTitle = "":               .ErrorTitle = ""
    .InputMessage = "":             .ErrorMessage = ""
    .ShowInput = True:              .ShowError = True
 End With
End Sub

Chúc thành công!
 
Lần chỉnh sửa cuối:
Vậy nên bạn thực hiện thử theo mình như sau:

Đến ô [AA1] & nhập vô đó cụm "GPE.COM"

(Lấy chuột) tô chọn 9 ô dưới nó & gán cho chúng 1 cái tên "GPE_"
(Có thể tô màu nền xanh nhạt cho 9 ô này nếu muốn)

Bước tiếp: Gán tên 'BTra' cho vùng [N4:P99] của trang tính

Tiếp theo bạn fải chuột vô tên trang tính & chọn dòng 'View Code' (E2007) & dán macro sự kiện này vô CS VBA vừa xuất hiện:

PHP:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
 If Not Intersect(Target, [e5:E99]) Is Nothing Then
    Dim Rng As Range, sRng As Range
    Dim MyAdd As String
    Dim W As Long
    ReDim Arr(1 To 9, 1 To 1) As String
    On Error Resume Next
    If Target.Offset(, 1).Value = "" Then
        MsgBox "Ban Chua Có Só Lieu!", , "GPE.COM Xin Chào!"
        Exit Sub
    End If
    Set Rng = Range("BTra")
    Set Rng = Rng(3).Resize(Rng.Rows.Count)
    Set sRng = Rng.Find(Target.Offset(, 1).Value, , xlFormulas, xlWhole)
    If Not sRng Is Nothing Then
        MyAdd = sRng.Address
        Do
            W = W + 1
            Arr(W, 1) = sRng.Offset(, -2).Value
            Set sRng = Rng.FindNext(sRng)
        Loop While Not sRng Is Nothing And sRng.Address <> MyAdd
    End If
    [AA2].Resize(9).Value = Arr()    
    GPE
 End If
End Sub

Tiếp nữa, bạn dán macro này vô module1:
Mã:
Sub GPE()
 With Selection.Validation
    .Delete
    .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=GPE_"
    .IgnoreBlank = True:            .InCellDropdown = True
    .InputTitle = "":               .ErrorTitle = ""
    .InputMessage = "":             .ErrorMessage = ""
    .ShowInput = True:              .ShowError = True
 End With
End Sub

Chúc thành công!
em cảm ơn bác
mà tại em dùng excel 2016
nên hình như ko có chỗ gán cái đoạn macro kia :(

em tỉm ra rồi mà nó ko cho gõ code vào
ko biết nó bị khóa hay bị sao bác nhỉ :(
 
Lần chỉnh sửa cuối:
Vậy nên bạn thực hiện thử theo mình như sau:

Đến ô [AA1] & nhập vô đó cụm "GPE.COM"

(Lấy chuột) tô chọn 9 ô dưới nó & gán cho chúng 1 cái tên "GPE_"
(Có thể tô màu nền xanh nhạt cho 9 ô này nếu muốn)

Bước tiếp: Gán tên 'BTra' cho vùng [N4:P99] của trang tính

Tiếp theo bạn fải chuột vô tên trang tính & chọn dòng 'View Code' (E2007) & dán macro sự kiện này vô CS VBA vừa xuất hiện:

PHP:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
 If Not Intersect(Target, [e5:E99]) Is Nothing Then
    Dim Rng As Range, sRng As Range
    Dim MyAdd As String
    Dim W As Long
    ReDim Arr(1 To 9, 1 To 1) As String
    On Error Resume Next
    If Target.Offset(, 1).Value = "" Then
        MsgBox "Ban Chua Có Só Lieu!", , "GPE.COM Xin Chào!"
        Exit Sub
    End If
    Set Rng = Range("BTra")
    Set Rng = Rng(3).Resize(Rng.Rows.Count)
    Set sRng = Rng.Find(Target.Offset(, 1).Value, , xlFormulas, xlWhole)
    If Not sRng Is Nothing Then
        MyAdd = sRng.Address
        Do
            W = W + 1
            Arr(W, 1) = sRng.Offset(, -2).Value
            Set sRng = Rng.FindNext(sRng)
        Loop While Not sRng Is Nothing And sRng.Address <> MyAdd
    End If
    [AA2].Resize(9).Value = Arr()    
    GPE
 End If
End Sub

Tiếp nữa, bạn dán macro này vô module1:
Mã:
Sub GPE()
 With Selection.Validation
    .Delete
    .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=GPE_"
    .IgnoreBlank = True:            .InCellDropdown = True
    .InputTitle = "":               .ErrorTitle = ""
    .InputMessage = "":             .ErrorMessage = ""
    .ShowInput = True:              .ShowError = True
 End With
End Sub

Chúc thành công!
nếu được a có thể cho em xin file excel a làm thử được ko ạ
em làm tử mãi ko được :(
 
Web KT

Bài viết mới nhất

Back
Top Bottom