Tôi làm code tìm kiếm 3 trường HOTEN, LOAI, KHUVUC theo Mã khách hàng băng phương thức Find.
Tôi có file thế này xin nhờ giải quyết một số vấn đề. (Tôi đã đọc hết topic này mà do trình độ còn hạn chế nên chưa biết lắp ráp xử lý thế nào cho ổn thỏa)
anh NDU mấy bữa rài hỏng có lên diễn đàn, chắc hỏng có rảnh
Cám ơn anh đã cho giải pháp. Vấn đề của tôi vẫn xoay quanh vlookup hoặc gì đó tương tự. Bởi vì tôi có nhu cầu thay đổi lại các mã hóa tại sheet "MA" và muốn sheet DMuc thay đổi theo. Giải pháp của anh sau khi nhập liệu xong thì dữ liệu đã "chết" và không ngo ngoe được nữa. Kính mong anh giúp tiếp.
Thầy cho em hỏi, khi tìm được mã ở sheet chi tiết, mình muốn lưu sheet chi tiết này sang sheet mới (sheet 3), rồi mình tìm tiếp và lưu sang sheet mới (sheet 4)... thì dùng code như thế nào ạ (nếu có thể lưu sang sheet khác thì vẫn canh chuẩn trang in ở sheet chi tiết). Em xin cám ơn ạ.
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
End Sub
Anh Ơi giúp em với: bây giờ thêm 1 cột"CỘT MỚI" Ở CỘT S thì sửa code như thế nào ạ? Em cảm ơn nhiều ạ
Em chào các bạn GPE.
@truongvu317 sao tớ không thấy nick cậu sáng nhỉ? Tớ vừa thấy cậu post bài xong.
Tớ ẩn trạng thái thì làm sao mà thấy được, mà không được đăng nhiều bài liên tục như trên, dễ bị coi là spam, rồi chặn nick cho mà xem rồi kêu khổ. Trên gpe này cứ yên tâm một điều là để bài rõ ràng thì chắc chắn những thành viên có khả năng giúp sẽ giúp.
Ẩn ở chỗ nào ấy cậu nhỉ? Cậu vào xem giúp tớ với. File nặng quá, mỗi lần mở ra đợi lâu, lúc chạy còn treo máy luôn.
Anh chị có teamviewer vào giúp em với ạ.
Sao mình dùng code nay nếu mã hành hóa lá chữ vd như A,B,C,D.. thì ok nhưng khi mã hàng là số thì khg dc. Mong các bác chỉ giáo. Mình khg lót file đc
Chuyển Key về dạng chuỗi, chỉnh lại tí tẹo
Private Sub Worksheet_Change(ByVal Target As Range)
Dim d, I, Vung, Ws
Set d = CreateObject("scripting.dictionary")
Set Ws = Sheets("MA")
Vung = Ws.Range(Ws.[B3], Ws.[B10000].End(xlUp)).Resize(, 3)
If Not Intersect(Target, Range("B4:B1000")) Is Nothing Then
If Target.Count = 1 Then
For I = 1 To UBound(Vung)
d.Add UCase(Vung(I, 1)), Array(Vung(I, 2), Vung(I, 3))
Next I
If d.exists(UCase(Target.Value)) Then
Target.Offset(, 1) = d.Item(UCase(Target.Value))(0)
Target.Offset(, 2) = d.Item(UCase(Target.Value))(1)
End If
End If
End If
End SubXin hỏi các anh chị nếu tên sheet có dấu thì sửa code này thế nào ạ
tên sheet là ngạch sớ thì sửa làm sao ạ
Sửa thành "Ngach_So"
Sửa file nguồn hả anh. hay sửa trong vba ạ. xin cảm ơn
Sửa cả 2, trong file tên sheet là gì thì viết trong VBA "y chang" vậy.
khổ nỗi tên sheet của em có dấu thì viết làm sao ạ
Tôi không biết cách nào. Thua luôn.
Dạ xin cám ơn nhiều
xin bác cho code hoàn chỉnh ạ. xin cám ơn
"Có lẽ..." đã được trả lời!Con chào Thầy,
Có lẽ là Thầy "ngại" vì có thể sẽ phát sinh thêm nhiều câu hỏi khác ạ
Private Sub Worksheet_Change(ByVal Target As Range)
Dim d, I, Vung, Ws
Dim tensheet As String
tensheet = "ng" & ChrW(7841) & "ch s" & ChrW(7899)
Set d = CreateObject("scripting.dictionary")
Set Ws = Sheets(tensheet)
Vung = Ws.Range(Ws.[B3], Ws.[B10000].End(xlUp)).Resize(, 3)
If Not Intersect(Target, Range("B4:B1000")) Is Nothing Then
If Target.Count = 1 Then
For I = 1 To UBound(Vung)
d.Add Vung(I, 1), Array(Vung(I, 2), Vung(I, 3))
Next I
If d.exists(UCase(Target.Value)) Then
Target.Offset(, 1) = d.Item(UCase(Target.Value))(0)
Target.Offset(, 2) = d.Item(UCase(Target.Value))(1)
End If
End If
End If
End SubDạ xin cảm ơn nhưng nó vẫn báo lỗi ạ
Bạn có thể gửi file kèm của bạn lên đây được không ạ?
dạ đây ạ
Bởi vì trong sheet "Ngạch sớ" bạn để 2 từ khóa tìm kiếm("B") trong cột B giống nhau.
dạ xin cảm ơn thật tuyệt. Xin hỏi có cách nào làm trên Module không ạ
Bỏ Dic được không bạn
Bác HieuCD giúp em mấy đường
Viết thử xem sao, tương tự code cũ chỉ bỏ Dic là ổn
Nhờ Bác Hiếu góp ý thêm ạ!
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim I As Long, Vung As Variant, Ws As Worksheet
Set Ws = Sheets("MA")
Vung = Ws.Range(Ws.[B3], Ws.[B10000].End(xlUp)).Resize(, 3)
If Not Intersect(Target, Range("B4:B1000")) Is Nothing Then
If Target.Count = 1 Then
For I = 1 To UBound(Vung)
If Target.Value = Vung(I, 1) Then
Target.Offset(, 1) = Vung(I, 2)
Target.Offset(, 2) = Vung(I, 3)
End If
Next I
End If
End If
End Subáp dụng sheet có dấu đi bạn ơi
Không sử dụng code của OT được đâu bạn vì nó rất dở, chỉ là OT cố viết theo gợi ý của Bác Hiếu để đưowjc Bác ấy chỉ dẫn thêm thôi
Private Sub Worksheet_Change(ByVal Target As Range)
Dim I As Long, Vung As Variant, Ws As Worksheet, Key As String
Dim tensheet As String
tensheet = "ng" & ChrW(7841) & "ch s" & ChrW(7899)
Set Ws = Sheets(tensheet)
Vung = Ws.Range(Ws.[B3], Ws.[B10000].End(xlUp)).Resize(, 3)
If Not Intersect(Target, Range("B4:B1000")) Is Nothing Then
If Target.Count = 1 Then
Key = Target.Value
For I = 1 To UBound(Vung)
If Key = Vung(I, 1) Then
Target.Offset(, 1) = Vung(I, 2)
Target.Offset(, 2) = Vung(I, 3)
Exit Sub
End If
Next I
End If
End If
End SubChuẩn rồi
Thêm lệnh Exit Sub sau khi gán kết quả để tăng tốc codeáp dụng sao không được nhỉ bạn ợiKhông sử dụng code của OT được đâu bạn vì nó rất dở, chỉ là OT cố viết theo gợi ý của Bác Hiếu để đưowjc Bác ấy chỉ dẫn thêm thôi
Trong trường hợp nếu nhập từ khóa không có trong danh mục từ khóa tìm kiếm thì OT chưa khắc phục được lỗi này.
Nếu bạn muốn thử trên sheet "Ngạch sớ" có dấu thì đây ạ:
Mã:Private Sub Worksheet_Change(ByVal Target As Range) Dim I As Long, Vung As Variant, Ws As Worksheet, Key As String Dim tensheet As String tensheet = "ng" & ChrW(7841) & "ch s" & ChrW(7899) Set Ws = Sheets(tensheet) Vung = Ws.Range(Ws.[B3], Ws.[B10000].End(xlUp)).Resize(, 3) If Not Intersect(Target, Range("B4:B1000")) Is Nothing Then If Target.Count = 1 Then Key = Target.Value For I = 1 To UBound(Vung) If Key = Vung(I, 1) Then Target.Offset(, 1) = Vung(I, 2) Target.Offset(, 2) = Vung(I, 3) Exit Sub End If Next I End If End If End Sub
Sửa: bổ thêm Exit Sub để tăng tốc
Copy code vào sheet CT
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("B4:B1000")) Is Nothing Then
If Target.Count = 1 Then
Application.EnableEvents = False
Application.ScreenUpdating = False
Target.Offset(0, 1).Resize(, 2) = Empty
Call VlookupVBA(Target)
Application.ScreenUpdating = True
Application.EnableEvents = True
End If
End If
End SubSub VlookupVBA(ByVal Target As Range)
Dim i As Long, sRow As Long
Dim sArr(), iKey As String, TenSheet As String
TenSheet = "Ng" & ChrW(7841) & "ch s" & ChrW(7899)
With Sheets(TenSheet)
i = .Range("B" & Rows.Count).End(xlUp).Row
If i < 3 Then Exit Sub
sArr = .Range("B3:D" & i).Value
End With
iKey = UCase(Target.Value)
sRow = UBound(sArr)
For i = 1 To sRow
If UCase(sArr(i, 1)) = iKey Then
Target.Offset(, 1) = sArr(i, 2)
Target.Offset(, 2) = sArr(i, 3)
Exit Sub
End If
Next i
End SubChuẩn rồi
Con đang tính thêm 1 vòng lặp nữa để làm việc này nhưng con chưa thử
Nói cụ thể hơn mới rỏ lỗi gìDạ, cảm ơn Bác Hiếu!
Nếu không sử dụng Dic thì con chưa biết khắc phục trường hợp này:
Con đang tính thêm 1 vòng lặp nữa để làm việc này nhưng con chưa thử
Bác chỉ thêm cho con ạ.
Ý bạn OT đang nói đến việc tìm kiếm trong vùng đó mà không có sẽ xảy ra lỗi #NA đó Anh, Bạn đó chắc muốn khử lỗi #NA này, Em đoán vậy, không biết đúng không nữa,
Dạ,ví dụ trong trường hợp nhập từ khóa là "AB" vào sheet "CT" mà trong sheet "Ngạch sớ" tại cột B không có từ khóa này Bác ạ.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim I As Long, Vung As Variant, Ws As Worksheet, Key As String
Dim tensheet As String
tensheet = "ng" & ChrW(7841) & "ch s" & ChrW(7899)
Set Ws = Sheets(tensheet)
Vung = Ws.Range(Ws.[B3], Ws.[B10000].End(xlUp)).Resize(, 3)
If Not Intersect(Target, Range("B4:B1000")) Is Nothing Then
If Target.Count = 1 Then
Target.Offset(, 1).Resize(, 2).ClearContents
Key = Target.Value
For I = 1 To UBound(Vung)
If Key = Vung(I, 1) Then
Target.Offset(, 1) = Vung(I, 2)
Target.Offset(, 2) = Vung(I, 3)
Exit Sub
End If
Next I
End If
End If
End SubXài mảng đây:
Option Explicit
Option Compare Text
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Vung(), I As Long, R As Long, DK As Boolean
If Not Intersect(Target, Range("B4:B1000")) Is Nothing Then
If Target.Count = 1 Then
Vung = Sheets("MA").Range("B3", Sheets("MA").Range("B10000").End(xlUp)).Resize(, 3).Value
R = UBound(Vung)
With Target
.Offset(, 1).Resize(, 2).ClearContents
For I = 1 To R
If .Value = Vung(I, 1) Then
.Offset(, 1) = Vung(I, 2)
.Offset(, 2) = Vung(I, 3)
DK = True
Exit Sub
End If
Next I
End With
If DK = False Then MsgBox "Khong tim thay Coi Ta Ba", , "GPE"
End If
End If
End SubDạ con cảm ơn Thầy nhiều.
Bạn có thể nói rõ hơn được không ạ?
Vâng thưa anh, khi em muốn điều chỉnh lấy dữ liệu ở sheet "MA" là cột 2, giá trị tìm kiếm thay sang ở cột 5, 6... ở sheet "CT" thì chỉnh như thế nào ạ? và khi quét vùng nhập dữ liệu ở cột B sheet "CT" xóa thì dữ liệu tìm kiếm không xóa theo. Như vậy phải khắc phục như thế nào ạ? Em chân thành cảm ơn!
Bạn gởi file cụ thể lên đi, tưởng tượng ra ý bạn muốn thì khó quá.
Vâng, vẫn là file cũ ah!
Ý em là ở Sheet "MA" thứ tự các cột là "mã, tên, đơn vị, đơn giá" khi giá trị tìm kiếm ở sheet "CT" thì thứ tự các cột có thể thay đổi "mã, xx,xx tên, đơn giá, đơn vị..." chẳng hạn. Không theo thứ tự cột thì phải làm thế nào ah?
Thử cái này.
Em cảm ơn anh rất nhiều, tuy ở đây có 1 cái lỗi là khi quét giá trị ở cột "MA" của sheet "CT" thì giá trị tìm kiếm không tự xóa theo mà phải xóa từng mã một. Có cách nào khắc phục không ah.
Không hiểu ý của bạn lắm.Nói rõ xem nào.
Quét xóa giá trị ở cột "MA" của sheet "CT" thì các giá trị tìm kiếm không xóa theo, mà chỉ xóa được từng mã một. Anh cứ xóa giá trị ở cột "MA" sẽ thấy ah.
Quét vùng đó và xóa thì giá trị tìm kiếm không tự xóa ah, chỉ xóa từng mã một thì mới được. Và còn 1 cái chưa hoàn thiện nữa nhờ anh giúp em là khi copy mã paste vào cột "MA" thì các giá trị tìm kiếm không nhận được mà chỉ nhập từng mã một mới nhận giá trị tìm kiếm ah. Anh giúp em khắc phục được điểm này nữa thì sẽ hoàn thiện hơn ạ. Em xin chân thành cảm ơn!
Bạn xem thử file này.
Thật tuyệt, cảm ơn anh rất nhiều.
Mong các anh giúp em với ạ? có như vậy mới thay thế được Vlookup khi có dùng công cụ Spinner. Em xin chân thành cảm ơn!
Bạn xem.
Dạ không chạy ah. Em phải thêm hàm này nó mới chạy. Anh xem giúp em với nhé! Em xin chân thành cảm ơn!
Nó vẫn vậy mà bạn.
Vâng được rồi ạ! thật tuyệt vời. Em xin chân thành cảm ơn, chúc anh luôn luôn mạnh khỏe!Nó vẫn vậy mà bạn.
Dim i As Long
For i = 1 To Range("K10000").End(xlUp).Row - 5
Range("D" & i + 5).Value = WorksheetFunction.VLookup(Range("K" & i + 5).Value, Sheet7.Range("B3:G400"), 2, 0)
Range("E" & i + 5).Value = WorksheetFunction.VLookup(Range("K" & i + 5).Value, Sheet7.Range("B3:G400"), 3, 0)
Range("F" & i + 5).Value = WorksheetFunction.VLookup(Range("K" & i + 5).Value, Sheet7.Range("B3:G400"), 4, 0)
Range("L" & i + 5).Value = WorksheetFunction.VLookup(Range("K" & i + 5).Value, Sheet7.Range("B3:G400"), 6, 0)
Range("O" & i + 5).Value = WorksheetFunction.VLookup(Range("K" & i + 5).Value, Sheet7.Range("B3:G400"), 5, 0)
Range("J" & i + 5).Value = WorksheetFunction.VLookup(Range("P" & i + 5).Value, Sheet7.Range("H3:I400"), 2, 0)
NextMỌI NGƯỜI CHO EM HỎI, EM DÙNG CODE NÀY NHƯNG KHI E THAY MÃ ABCD THÀNH SỐ 1234 THÌ LẠI KHÔNG ĐƯỢC NHỈ?
Bạn cho file lên xem sao.Khả năng là 1 cái của bạn nó nhận string 1 cái là số nên không được.
anh ơi giúp em thêm code để mục bán hàng có thể thay thế được các công thức index ở sheet BANHANG VỚI AH
Thì ít ra bạn cũng lôi cái code đó lên đây.Và xem nó lỗi ở đâu.Tốt nhất gửi file lỗi lên.
