hoangvinh_tb
Thành viên mới

- Tham gia
- 16/6/08
- Bài viết
- 20
- Được thích
- 4
Mã nó đâyMình gửi vd lên nhờ các bắc bớt chút thời gian chỉ dùm vài chiêu
Cảm ơn các bạn nhiều!!!
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 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 Sub
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("B4:B99")) Is Nothing Then
Dim Rng As Range, sRng As Range, Sh As Worksheet
Set Sh = ThisWorkbook.Worksheets("MA")
Set Rng = Sh.Range(Sh.[b2], Sh.[b2].End(xlDown))
Set sRng = Rng.Find(Target.Value, , xlFormulas, xlWhole)
If sRng Is Nothing Then
MsgBox "Nothing"
Else
Target.Offset(, 1).Resize(, 2).Value = sRng.Offset(, 1).Resize(, 2).Value
End If
End If
End Sub
Cám ơn bạn đã gửi cho mình đoạn mã này! nhưng mình muốn triển khai đoạn mã đó mà vẫn chưa làm đc mong bạn giải thích và giúp mình nhé
Mình muốn cột địa chỉ di chuyển các cột tên khoảng 5 cột
cám ơn bạn đã góp chân thành mình cũng định gửi file đính kèm mà không có cách nào đính kèm đc mong bạn và các bạn trong diễn đàn thông cảm.5 cột ấy là những cột nào vậy bạn ? Nhiều người trên diễn đàn (trong đó có tôi) cho rằng hỏi bài mà không gửi file đính kèm và không diễn đạt rõ yêu cầu là thiếu trách nhiệm với câu hỏi của mình và thiếu tôn trọng người mình hỏi.
Mình cũng đang cần cái này, cảm ơn pro. cái này hay lắm. Mình làm cửa hàng bán lẻ, hằng ngày phải xuất kho tương đối nhiều phiếu giao hàng trong 1 thời gian ngắn. Dùng hàm vlookup file excel lên đến 150MB nhìn đã thấy khiếp. đang tìm mã vba để thay thế vlookup. Thank pro nhé.Mã nó đây
RightClick vào sheet "CT" ==> View Code chép cái này vào
ThânMã: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 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 Sub
code này hay, lâu nay mình lại dùng 2 vòng for hèn gì mà khi dữ liệu nhiều thì tìm kiếm lâu lắc.Mã nó đây
RightClick vào sheet "CT" ==> View Code chép cái này vào
ThânMã: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 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 Sub
Sub TimKiem_Vlookup()
Dim i As Long, j As Long, sArray1, sArray2, Arr()
With Sheets("MA")
sArray1 = .Range(.[B3], .[B65000].End(xlUp)).Resize(, 3).Value
End With
With Sheets("CT")
.Range("C4:D65000").ClearContents
sArray2 = .Range(.[B4], .[B65000].End(xlUp)).Value
ReDim Arr(1 To UBound(sArray2, 1), 1 To 2)
For j = 1 To UBound(sArray2, 1)
For i = 1 To UBound(sArray1, 1)
If Not IsEmpty(sArray2(j, 1)) And sArray1(i, 1) = UCase(sArray2(j, 1)) Then
Arr(j, 1) = sArray1(i, 2)
Arr(j, 2) = sArray1(i, 3)
End If
Next
Next
.Range("C4").Resize(j - 1, 2).Value = Arr
End With
End Sub
Chào bác concogia và các cao thủ.Mã nó đây
RightClick vào sheet "CT" ==> View Code chép cái này vào
ThânMã: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 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 Sub
Code trên là viết theo đề bài của bạn hoangvinh_tb, còn nếu theo ý của bạn thì ta vẫn viết theo cách cũ + một vòng lặp For ...... Next nữa, tức là một vòng tạo Dictionary, một vòng lấy mảng kết quảcode này hay, lâu nay mình lại dùng 2 vòng for hèn gì mà khi dữ liệu nhiều thì tìm kiếm lâu lắc.
==============================================
Sau khi thử code trên mình thấy chỉ tìm kiếm được cho từng mã khi click vào ô đó (tức là nhập vào giá trị mã cho ô đó thì sẽ tìm kiếm cho mã tại ô đó). Vậy nếu mình có sẵn 1 danh sách mã và muốn tìm kiếm cho 1 danh sách mã đó thì ko lẽ phải click từng mã mới tìm kiếm được. Mình vẫn phải dùng 2 vòng For, 1 vòng for cho vùng chứa dữ liệu tìm kiếm và 1 vòng for cho vùng chứa mã muốn tìm kiếm. Với cách này dữ liệu hàng chục ngàn dòng thì code chạy lâu, có cách nào khác không nhỉ?
PHP:Sub TimKiem_Vlookup() Dim i As Long, j As Long, sArray1, sArray2, Arr() With Sheets("MA") sArray1 = .Range(.[B3], .[B65000].End(xlUp)).Resize(, 3).Value End With With Sheets("CT") .Range("C4:D65000").ClearContents sArray2 = .Range(.[B4], .[B65000].End(xlUp)).Value ReDim Arr(1 To UBound(sArray2, 1), 1 To 2) For j = 1 To UBound(sArray2, 1) For i = 1 To UBound(sArray1, 1) If Not IsEmpty(sArray2(j, 1)) And sArray1(i, 1) = UCase(sArray2(j, 1)) Then Arr(j, 1) = sArray1(i, 2) Arr(j, 2) = sArray1(i, 3) End If Next Next .Range("C4").Resize(j - 1, 2).Value = Arr End With End Sub
Bạn chép code này đè lên cái cũ nhéChào bác concogia và các cao thủ.
EM đang cần làm 1 cái phiếu xuất kho cũng thay thế hàm vlookup bằng mã VBA, copy mã của bác concogia về chạy thử thì rất ok. Chỉ có điều em muốn link thêm giá trị từ Sheet 'MA' sang sheet 'CT', mà ko biết sửa thế nào nhờ bác concogia và các cao thủ sử giúp. Em xin cảm ơn các bác.
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(, 4)
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), Vung(I, 4))
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)
Target.Offset(, 5) = d.Item(UCase(Target.Value))(2)
End If
End If
End If
End Sub
m mò ra rồi, Cảm ơn các bác nhiều...Chào bác concogia và các cao thủ.
EM đang cần làm 1 cái phiếu xuất kho cũng thay thế hàm vlookup bằng mã VBA, copy mã của bác concogia về chạy thử thì rất ok. Chỉ có điều em muốn link thêm giá trị từ Sheet 'MA' sang sheet 'CT', mà ko biết sửa thế nào nhờ bác concogia và các cao thủ sử giúp. Em xin cảm ơn các bác.
Bạn chép code này đè lên cái cũ nhé
ThânMã: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(, 4) 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), Vung(I, 4)) 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) Target.Offset(, 5) = d.Item(UCase(Target.Value))(2) End If End If End If End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Dim I, Vung, Ws
Set Ws = Sheets("MA")
Vung = Ws.Range(Ws.[B3], Ws.[B10000].End(xlUp)).Resize(, 4)
If Not Intersect(Target, Range("B4:B1000")) Is Nothing Then
If Target.Count = 1 Then
For I = 1 To UBound(Vung)
If Vung(I, 1) = Ucase(Target.Value) Then
Target.Offset(, 1) = Vung(I, 2)
Target.Offset(, 2) = Vung(I, 3)
Target.Offset(, 5) = Vung(I, 4)
Exit For
End If
Next I
End If
End If
End Sub
Tôi thấy có vẻ nhiều người hơi lạm dụng Dictionary. Dictionary mạnh và không dễ thay thế được trong một vài trường hợp không có nghĩa là nó tốt cho mọi trường hợp. Tỏi nếu nấu với món "này" thì tuyệt nhưng không có nghĩa là nấu món nào cũng cho tỏi. Không phải mổ trâu, lợn, gà, bóc tỏi, gọt táo đều dùng dao mổ trâu. Lợi thì chắc không mà hại thì nhiều.
Sửa một chút code trên thành
Mã:Private Sub Worksheet_Change(ByVal Target As Range) Dim I, Vung, Ws Set Ws = Sheets("MA") Vung = Ws.Range(Ws.[B3], Ws.[B10000].End(xlUp)).Resize(, 4) If Not Intersect(Target, Range("B4:B1000")) Is Nothing Then If Target.Count = 1 Then For I = 1 To UBound(Vung) If Vung(I, 1) = Ucase(Target.Value) Then Target.Offset(, 1) = Vung(I, 2) Target.Offset(, 2) = Vung(I, 3) Target.Offset(, 5) = Vung(I, 4) Exit For End If Next I End If End If End Sub
nếu tôi không lầm thì code tốt hơn. Trong trường hợp xấu nhất thì cũng chỉ phải duyệt (FOR) tất cả các dòng của Vung, còn trong trường hợp tốt nhất thì chỉ duyệt có 1 dòng. Dùng Dictionary như trên luôn phải duyệt tất cả các dòng, rồi với mỗi dòng đó làm "động tác" d.Add ... (thừa)
Nếu số dòng không phải là "vài" mà là "mấy trăm" (mã không phải là A --> Z mà là vd. wxyz) thì chắc chắn code dùng Dictionary như trên sẽ làm nhiều việc hơn, lâu hơn.
Bạn có thể thêm đoạn code màu đỏ này vào code của bạn Concogia, cách làm tương tự nếu bạn muốn xóa thêm phần nào đó cho mã đó.
Chào bác 'concogia', em đã làm theo cách của bác, file excel của em chạy rất ổn, dung lượng file giảm từ 150MB xuống còn 24MB, quá tuyệt luôn. File nhanh, tuy nhiên em gặp một số vấn đề cần bác phát triển thêm giúp em.Bạn chép code này đè lên cái cũ nhé
ThânMã: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(, 4) 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), Vung(I, 4)) 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) Target.Offset(, 5) = d.Item(UCase(Target.Value))(2) End If End If End If End Sub
Em đã thử cách của bác nhưng khi thao tác xóa từng ô thì các giá trị ở cột sản phẩm, đơn vị, đơn giá cũng mất. nhưng nếu quét nhiều ô để xóa thì các giá trị khác vẫn giữ nguyên. làm thế nào để khi quét nhiều ô để xóa thì các giá trị khác cũng bị xóa hả bác 'qtm1987'Bạn có thể thêm đoạn code màu đỏ này vào code của bạn Concogia, cách làm tương tự nếu bạn muốn xóa thêm phần nào đó cho mã đó.
....
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)
ElseIf IsEmpty(Target) Then
Target.Offset(, 1) = ""
Target.Offset(, 2) = ""
End If
...
Đây là thiếu sót của tất cả các code từ đầu topic đến giờEm đã thử cách của bác nhưng khi thao tác xóa từng ô thì các giá trị ở cột sản phẩm, đơn vị, đơn giá cũng mất. nhưng nếu quét nhiều ô để xóa thì các giá trị khác vẫn giữ nguyên. làm thế nào để khi quét nhiều ô để xóa thì các giá trị khác cũng bị xóa hả bác 'qtm1987'
Đây chính là lúc dùng đến Dictionary nè!Tôi thấy có vẻ nhiều người hơi lạm dụng Dictionary. Dictionary mạnh và không dễ thay thế được trong một vài trường hợp không có nghĩa là nó tốt cho mọi trường hợp. Tỏi nếu nấu với món "này" thì tuyệt nhưng không có nghĩa là nấu món nào cũng cho tỏi. Không phải mổ trâu, lợn, gà, bóc tỏi, gọt táo đều dùng dao mổ trâu. Lợi thì chắc không mà hại thì nhiều.
Sửa một chút code trên thành
.
Đây là thiếu sót của tất cả các code từ đầu topic đến giờ
Dùng sự kiện Worksheet_Change phải biết rằng Target không phải luôn là 1 cell ---> Đôi khi ngươi ta copy/paste( hoặc quét chọn khối cell rồi Delete như bạn làm) thì sao?
Chính vì thế phải cho thêm công đoạn quét toàn bộ các cell thuộc Target (For Each Clls in Target chẳng hạn)
Nói chung dạng bài này cũng đã từng post trên diễn đàn rồi... nếu khéo léo, có thể dùng Array để tăng tốc bảng tính
Các bạn khác đang nghiên cứu về VBA code thừ cải tiến lại xem
(tôi làm hoài dạng này đâm chán luôn)
--------------------------------------
Đây chính là lúc dùng đến Dictionary nè!
Tuy nhiên, nếu khéo hơn thì ta chỉ tạo và nạp Dictionary 1 lần duy nhất (nếu Dictionary chưa được tạo) ---> Những lần sau đó của sự kiện Change, chỉ việc "vào" Dic "moi" ra xài thôi
Làm thử trên file của bạn nhé:BÁc ndu96081631 Hướng dẫn cụ thể cách thêm For Each Clls in Target như thế nào?
“...có thể dùng Array để tăng tốc bảng tính” : bác gúp em và mọi người đoạn code để học hỏi thêm.
Nhờ bác cùng các Pro tùy biến giúp bài của em bên Topic Cần hướng dẫn và trợ giúp về sử dụng Vlookup trong VBA excel!
Xin cảm ơn!
Public Chk As Boolean, Dic As Object, aResult()
Sub Auto_Open()
Dim wks As Worksheet, SrcRng As Range, sArray
Dim lR As Long, i As Long, n As Long, tmp
On Error Resume Next
Set wks = Sheets("LLNV")
Set SrcRng = wks.Range("B6:R1000")
sArray = SrcRng.Value
ReDim aResult(1 To UBound(sArray, 1), 1 To UBound(sArray, 2))
Set Dic = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(sArray, 1)
If CStr(sArray(i, 1)) <> "" Then
tmp = sArray(i, 1)
If Not Dic.Exists(tmp) Then
lR = lR + 1
Dic.Add tmp, lR
aResult(lR, 1) = tmp
aResult(lR, 2) = sArray(i, 2)
aResult(lR, 3) = sArray(i, 3)
aResult(lR, 5) = sArray(i, 5)
aResult(lR, 6) = sArray(i, 6)
aResult(lR, 14) = sArray(i, 14)
aResult(lR, 13) = sArray(i, 13)
End If
End If
Next
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Chk = True
End Sub
Private Sub Worksheet_Deactivate()
If Chk Then
Auto_Open
Chk = False
End If
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rTarget As Range, aTarget, i As Long, n As Long
Dim Arr1(), Arr2(), Arr3(), tmp
On Error Resume Next
If Dic Is Nothing Then Auto_Open
If Not Intersect(Range("C6:C1000"), Target) Is Nothing Then
Set rTarget = Intersect(Range("C6:C1000"), Target)
If IsArray(rTarget.Value) Then
aTarget = rTarget.Value
Else
ReDim aTarget(1 To 1, 1 To 1)
aTarget(1, 1) = rTarget.Value
End If
ReDim Arr1(1 To UBound(aTarget, 1), 1 To 2)
ReDim Arr2(1 To UBound(aTarget, 1), 1 To 3)
ReDim Arr3(1 To UBound(aTarget, 1), 1 To 1)
For i = 1 To UBound(aTarget, 1)
If aTarget(i, 1) <> "" Then
tmp = aTarget(i, 1)
If Dic.Exists(tmp) Then
Arr1(i, 1) = aResult(Dic.Item(tmp), 2)
Arr1(i, 2) = aResult(Dic.Item(tmp), 3)
Arr2(i, 1) = aResult(Dic.Item(tmp), 5)
Arr2(i, 2) = aResult(Dic.Item(tmp), 6)
Arr2(i, 3) = aResult(Dic.Item(tmp), 14)
Arr3(i, 1) = aResult(Dic.Item(tmp), 13)
End If
End If
Next
rTarget.Offset(, 1).Resize(, 2).Value = Arr1
rTarget.Offset(, 4).Resize(, 3).Value = Arr2
rTarget.Offset(, 11).Resize(, 1).Value = Arr3
End If
End Sub
Nguyên văn bởi siwtomTôi thấy có vẻ nhiều người hơi lạm dụng Dictionary. Dictionary mạnh và không dễ thay thế được trong một vài trường hợp không có nghĩa là nó tốt cho mọi trường hợp. Tỏi nếu nấu với món "này" thì tuyệt nhưng không có nghĩa là nấu món nào cũng cho tỏi. Không phải mổ trâu, lợn, gà, bóc tỏi, gọt táo đều dùng dao mổ trâu. Lợi thì chắc không mà hại thì nhiều.
Sửa một chút code trên thành
.
Đây chính là lúc dùng đến Dictionary nè!
Tuy nhiên, nếu khéo hơn thì ta chỉ tạo và nạp Dictionary 1 lần duy nhất (nếu Dictionary chưa được tạo) ---> Những lần sau đó của sự kiện Change, chỉ việc "vào" Dic "moi" ra xài thôi
Híc, hôm nay mình mới đọc được bài này. Ý của bạn siwtom cũng đúng thôi, thật ra bài này mình muốn thử Item của Dictionary là một Array xem nó như thế nào, xử lý nó có linh hoạt không thôi (trước kia mình hay gom vào một cục, khi xử lý thì dùng Split tách nó ra, sau khi đọc bài của bạn Kyo mình mới biết Item có thể là một Array _ vì toàn mò mẫm tự học_ ) chứ với đề bài trên & dữ liệu không thật lớn thì dùng Find ( bài của chị Hải Yến) hoặc chơi cùi bắp hơn thì dùng Match thì khỏi phải " Pho với Phiếc", "Đít-to với Đít-bé" chi cho rách việcTôi thấy có vẻ nhiều người hơi lạm dụng Dictionary. Dictionary mạnh và không dễ thay thế được trong một vài trường hợp không có nghĩa là nó tốt cho mọi trường hợp. Tỏi nếu nấu với món "này" thì tuyệt nhưng không có nghĩa là nấu món nào cũng cho tỏi. Không phải mổ trâu, lợn, gà, bóc tỏi, gọt táo đều dùng dao mổ trâu. Lợi thì chắc không mà hại thì nhiều.
Sửa một chút code trên thành
Mã:Private Sub Worksheet_Change(ByVal Target As Range) Dim I, Vung, Ws Set Ws = Sheets("MA") Vung = Ws.Range(Ws.[B3], Ws.[B10000].End(xlUp)).Resize(, 4) If Not Intersect(Target, Range("B4:B1000")) Is Nothing Then If Target.Count = 1 Then For I = 1 To UBound(Vung) If Vung(I, 1) = Ucase(Target.Value) Then Target.Offset(, 1) = Vung(I, 2) Target.Offset(, 2) = Vung(I, 3) Target.Offset(, 5) = Vung(I, 4) Exit For End If Next I End If End If End Sub
nếu tôi không lầm thì code tốt hơn. Trong trường hợp xấu nhất thì cũng chỉ phải duyệt (FOR) tất cả các dòng của Vung, còn trong trường hợp tốt nhất thì chỉ duyệt có 1 dòng. Dùng Dictionary như trên luôn phải duyệt tất cả các dòng, rồi với mỗi dòng đó làm "động tác" d.Add ... (thừa)
Nếu số dòng không phải là "vài" mà là "mấy trăm" (mã không phải là A --> Z mà là vd. wxyz) thì chắc chắn code dùng Dictionary như trên sẽ làm nhiều việc hơn, lâu hơn.
Híc, hôm nay mình mới đọc được bài này. Ý của bạn siwtom cũng đúng thôi, thật ra bài này mình muốn thử Item của Dictionary là một Array xem nó như thế nào, xử lý nó có linh hoạt không thôi (trước kia mình hay gom vào một cục, khi xử lý thì dùng Split tách nó ra, sau khi đọc bài của bạn Kyo mình mới biết Item có thể là một Array _ vì toàn mò mẫm tự học_ ) chứ với đề bài trên & dữ liệu không thật lớn thì dùng Find ( bài của chị Hải Yến) hoặc chơi cùi bắp hơn thì dùng Match thì khỏi phải " Pho với Phiếc", "Đít-to với Đít-bé" chi cho rách việc
Thân ái
Rất cám ơn anh ndu96081631 đã giúp đỡ về code.
Do kiến thức của em về Code VBA quá hạn chế nên từ chiều đến giờ em ngồi xem code của bác và tìm cách để lookup những cột còn lại (K, L, M, O) mà em chưa làm được. mong anh chỉ cho.
ở trong Sheet ChiTiet, cột N (cột THƯỜNG TRÚ) hình như anh lookup nhầm cột "Nơi cấp" thì phải. anh sửa lại code giúp em nhé.
Nếu em có nhiều Sheet tương tự cần Lookup từ Sheet LLNV, mỗi Sheet có số cột cần lookup khác nhau và chỉ số cột cần lookup cũng khác nhau. Để có thể vận dụng code của anh vào những sheet này thì em cần lưu ý và thay đổi những chỗ nào trong code để đạt được yêu cầu lookup của các Sheet.
Rất mong anh ndu96081631 cùng các Pro trên GPE hướng dẫn thêm.
If IsArray(rTarget.Value) Then
aTarget = rTarget.Value
Else
ReDim aTarget(1 To 1, 1 To 1)
aTarget(1, 1) = rTarget.Value
End If
Ah... cái đoạn code đó không liên quan gì đến vấn đề bạn nói cả... Chẳng qua nếu chuyển toàn bộ sang Array thì phải lưu ý xem Target có phải là 1 cell hay không (nếu Target gồm nhiều cell thì Target.Value là 1 Array nhưng nếu Target là 1 cell thì Target.Value không phải là Array)Kiến thức của tôi cũng vô cùng hạn chế nhưng tôi mạo muội có ý kiến. Tôi thấy đoạn
có vẻ chưa ổn lắm. Đểm kiểm nghiệm ta thử như sau:Mã:If IsArray(rTarget.Value) Then aTarget = rTarget.Value Else ReDim aTarget(1 To 1, 1 To 1) aTarget(1, 1) = rTarget.Value End If
Nếu vd. ND chọn xóa 1 ô ở cột C hoặc một loạt ô ở các dòng liên tiếp thì không sao. Nhưng nếu chọn vài ô không ở các dòng lên tiếp - tức từ "ô đầu" tới "ô cuối" có ô không được chọn để xóa thì code làm không theo ý muốn.
Nếu tôi nhầm lẫn thì xin thứ lỗi cho. Tôi chỉ muốn là nếu cảm nhận của tôi là đúng thì ai dùng cứ dùng nhưng phải ý thức được điều đó.
Rất cám ơn anh ndu96081631 đã giúp đỡ về code.
Do kiến thức của em về Code VBA quá hạn chế nên từ chiều đến giờ em ngồi xem code của bác và tìm cách để lookup những cột còn lại (K, L, M, O) mà em chưa làm được. mong anh chỉ cho.
ở trong Sheet ChiTiet, cột N (cột THƯỜNG TRÚ) hình như anh lookup nhầm cột "Nơi cấp" thì phải. anh sửa lại code giúp em nhé.
Nếu em có nhiều Sheet tương tự cần Lookup từ Sheet LLNV, mỗi Sheet có số cột cần lookup khác nhau và chỉ số cột cần lookup cũng khác nhau. Để có thể vận dụng code của anh vào những sheet này thì em cần lưu ý và thay đổi những chỗ nào trong code để đạt được yêu cầu lookup của các Sheet.
Rất mong anh ndu96081631 cùng các Pro trên GPE hướng dẫn thêm.
Public Chk As Boolean, Dic As Object, aResult()
Sub Auto_Open()
Dim wks As Worksheet, SrcRng As Range, sArray
Dim lR As Long, i As Long, j As Long, n As Long, tmp
On Error Resume Next
Set wks = Sheets("LLNV")
Set SrcRng = wks.Range("B6:R1000")
sArray = SrcRng.Value
ReDim aResult(1 To UBound(sArray, 1), 1 To UBound(sArray, 2))
Set Dic = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(sArray, 1)
If CStr(sArray(i, 1)) <> "" Then
tmp = sArray(i, 1)
If Not Dic.Exists(tmp) Then
lR = lR + 1
Dic.Add tmp, lR
For j = 1 To 17
aResult(lR, j) = sArray(i, j)
Next
End If
End If
Next
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rTarget As Range, aTarget, i As Long, n As Long
Dim Arr1(), Arr2(), Arr3(), tmp
On Error Resume Next
If Dic Is Nothing Then Auto_Open
If Not Intersect(Range("C6:C1000"), Target) Is Nothing Then
Set rTarget = Intersect(Range("C6:C1000"), Target)
If IsArray(rTarget.Value) Then
aTarget = rTarget.Value
Else
ReDim aTarget(1 To 1, 1 To 1)
aTarget(1, 1) = rTarget.Value
End If
ReDim Arr1(1 To UBound(aTarget, 1), 1 To 2)
ReDim Arr2(1 To UBound(aTarget, 1), 1 To 3)
ReDim Arr3(1 To UBound(aTarget, 1), 1 To 5)
For i = 1 To UBound(aTarget, 1)
If aTarget(i, 1) <> "" Then
tmp = aTarget(i, 1)
If Dic.Exists(tmp) Then
Arr1(i, 1) = aResult(Dic.Item(tmp), 2)
Arr1(i, 2) = aResult(Dic.Item(tmp), 3)
Arr2(i, 1) = aResult(Dic.Item(tmp), 5)
Arr2(i, 2) = aResult(Dic.Item(tmp), 6)
Arr2(i, 3) = aResult(Dic.Item(tmp), 14)
Arr3(i, 1) = aResult(Dic.Item(tmp), 7)
Arr3(i, 2) = aResult(Dic.Item(tmp), 8)
Arr3(i, 3) = aResult(Dic.Item(tmp), 11)
Arr3(i, 4) = aResult(Dic.Item(tmp), 15)
Arr3(i, 5) = aResult(Dic.Item(tmp), 4)
End If
End If
Next
rTarget.Offset(, 1).Resize(, 2).Value = Arr1
rTarget.Offset(, 4).Resize(, 3).Value = Arr2
rTarget.Offset(, 8).Resize(, 5).Value = Arr3
End If
End Sub
Ah... cái đoạn code đó không liên quan gì đến vấn đề bạn nói cả... Chẳng qua nếu chuyển toàn bộ sang Array thì phải lưu ý xem Target có phải là 1 cell hay không (nếu Target gồm nhiều cell thì Target.Value là 1 Array nhưng nếu Target là 1 cell thì Target.Value không phải là Array)
Còn vấn đề bạn vừa nói thật ra giải quyết nó cũng không có vấn đề gì... Có điều nếu chuyển mọi thứ sang xử lý mảng thì hơi rắc rối chút ----> Dạng Array trong Array đấy mà
Để từ từ tôi nghiên cứu thêm việc này
Cảm ơn bạn đã nhắc nhở!
If IsArray(rTarget.Value) Then
aTarget = rTarget.Value
Else
ReDim aTarget(1 To 1, 1 To 1)
aTarget(1, 1) = rTarget.Value
End If
rTarget.Offset(, 1).Resize(, 2).Value = Arr1
rTarget.Offset(, 4).Resize(, 3).Value = Arr2
rTarget.Offset(, 8).Resize(, 5).Value = Arr3
If aTarget(i, 1) <> "" Then
End If
Dám cá với bạn là nhanh gấp 100 lần (nếu không thì người ta xài công thức cho rồi)Bài này cần xem lại ý tưởng ngay từ đầu: không thể viết hàm VBA mà nhanh hơn Vlookup được, Chắc chắn là chậm hơn hàm gốc, có chăng là cái "chậm nhiều" này được chia đều ra và đẩy vào ngay giai đoạn nhập liệu.
Dám cá với bạn là nhanh gấp 100 lần (nếu không thì người ta xài công thức cho rồi)
Còn dùng VBA mà "mượn tạm" thằng VLOOKUP để làm cũng chậm luôn... Chỉ có cách dùng Array mới là nhanh nhất thôi
Không tin bạn có thể thí nghiệm với dữ liệu tùy ý
Bài này cần xem lại ý tưởng ngay từ đầu: không thể viết hàm VBA mà nhanh hơn Vlookup được, Chắc chắn là chậm hơn hàm gốc, có chăng là cái "chậm nhiều" này được chia đều ra và đẩy vào ngay giai đoạn nhập liệu.
Nếu xem xét ý tưởng dưới góc độ thế, thì khỏi cần phải VBA code dài dòng vậy, mà hãy dùng ngay Vlookup chuẩn sẵn có trong Excel và biến thành "giá trị" (value) là đủ
Thấy file của người hỏi đều là "thuc hanh" -- chứng tỏ người hỏi đang muốn học hỏi lập trình, vậy hãy chúng ta phải nhìn nhận lại ý tưởng ngay từ đâu
Nếu ý kiến tôi có không hợp, thì có thể do tiêu đề topic là chưa chuẩn sát
- Không dấu gì bạn và mọi người, mình làm ở bộ phận nhân sự, chỗ mình làm vẫn quản lý nhân viên trên Excel và toàn bộ là nhập liệu bằng tay hết, rất mất thời gian. để tiện cho việc quản lý nhân viên mình đang mò mẫm hoàn chỉnh lại các mẫu biểu quản lý và các hàm, công thức sử dụng trong đó để thuận tiện hơn cho công việc quản lý nhân viên của mình. Vì vậy mình để tên file là Thực hành. Và mình cũng muốn tìm hiểu thêm một chút VBA để vận dụng cho công việc hiện tại của mình.
Thật ra tôi rất thích tranh luận để chứng minh vấn đềVấn đề là anh nhận định sai rồi, Hàm của anh không nhanh hơn Vlookup được, cái này là chắc chắn
.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rTarget As Range, aTarget, i As Long, j As Long, n As Long, TG As Double
Dim Arr(), tmp
On Error Resume Next
TG = Timer
If Dic Is Nothing Then Auto_Open
If Not Intersect(Range("C6:C65536"), Target) Is Nothing Then
Set rTarget = Intersect(Range("C6:C65536"), Target)
If IsArray(rTarget.Value) Then
aTarget = rTarget.Value
Else
ReDim aTarget(1 To 1, 1 To 1)
aTarget(1, 1) = rTarget.Value
End If
ReDim Arr(1 To UBound(aTarget, 1), 1 To 17)
For i = 1 To UBound(aTarget, 1)
If aTarget(i, 1) <> "" Then
tmp = aTarget(i, 1)
If Dic.Exists(tmp) Then
For j = 2 To 17
Arr(i, j - 1) = aResult(Dic.Item(tmp), j)
Next
End If
End If
Next
rTarget.Offset(, 1).Resize(, 16).Value = Arr
MsgBox Timer - TG
End If
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rTarget As Range, aTarget, i As Long, j As Long, n As Long, TG As Double
Dim Arr(), tmp
On Error Resume Next
TG = Timer
If Not Intersect(Range("C6:C65536"), Target) Is Nothing Then
Set rTarget = Intersect(Range("C6:C65536"), Target)
With rTarget.Offset(, 1).Resize(, 16)
.Value = "=IF(RC3="""","""",VLOOKUP(RC3,LLNV!R5C2:R10000C18,2,0))"
.Value = .Value
End With
MsgBox Timer - TG
End If
End Sub
Bạn muốn dữ liệu "chuẩn" thế nào, hoặc muốn sửa VLOOKUP như thế nào, cứ đưa lên đây, chúng ta sẽ cùng thí nghiệm để bạn tâm phục khẩu phục về tốc độ của xử lý ArrayCòn "mượn tạm" thì tôi không nhận xét, vì thí nghiệm kiểu dữ liệu này không chuẩn, và hơn nữa trình VBA của tôi cũng có hạn.
Thật ra tôi rất thích tranh luận để chứng minh vấn đề
Vậy thay vì nói suông ta làm cuộc thí nghiệm với 10000 dòng dữ liệu giữa code của tôi VS với VLOOKUP nhé (xem file)
Bạn muốn dữ liệu "chuẩn" thế nào, hoặc muốn sửa VLOOKUP như thế nào, cứ đưa lên đây, chúng ta sẽ cùng thí nghiệm để bạn tâm phục khẩu phục về tốc độ của xử lý Array
vodoi2x: Từ hôm nọ tôi đọc rất nhiều bài của bác, phải nói bác rất chịu khó tranh luận, tuy vậy một số bài tranh luận của bác (không phải tất cả) dường như có cảm giác thiếu cơ sở gì đó (có lẽ nhiều vấn đề bác hiểu không sâu như các thày trên diễn đàn).
Thì bạn cứ thử điAnh tính thời gian thế này thì sai rồi, anh phải tính cả thời gian mà load cho diction ary ban đầu nữa,.
Bạn cứ hay lòng vòng không đi thằng vào vấn đềTôi đã viết là với hàm lập VBA so sánh cùng hàm chuẩn Vlookup trong excel thì sẽ chậm hơn là cái chắc chắn, NÊN tôi mới nói chủ topic xem lại tiêu đề cho hợp lý,
.
Thì bạn cứ thử đi
Đoạn:
If Dic Is Nothing Then Autpen
Hãy sửa thành
Autpen
rồi thí nghiệm lại sẽ biết liền chứ gì
Ẹc... Ẹc...
Có vẻ như tranh luận chẳng đi đến đâu (ông nói gà bà nói vịt)Oh, anh vẫn ngoan cố hiểu sai hướng (hay cố tình nhỉ), hihihiiiii
Ý của tôi ở đây là không phải bài cụ thể này (vì đó không phải là chuẩn).
Anh cứ viết 1 hàm bằng VBA đầy đủ chức năng như của VLookup rồi đem so sánh nhé, chứ nói đi nói lại, anh cũng mãi không hiểu, ĐIều gì đúng chúng ta phải công nhận là đúng thì phải đúng: VBA chỉ là công cụ trợ giúp thôi - cái nào có sẵn thì nên sử dụng vẫn hơn.
Đó là lý do tôi ý kiến về tiêu đề topic, song vẫn khuyên chủ topic theo hướng giải quyết đó -- (anh đọc lại bài tôi viết trả lời chủ topic là hiểu ngay)
Thanks
Có vẻ như tranh luận chẳng đi đến đâu (ông nói gà bà nói vịt)
Và ý kiến của bạn thật ra cũng chẳng liên quan gì đến chủ đề của topic
Rảnh rỗi làm lại cho bạn theo sự bố trí của dữ liệu mới đâyCho em hỏi mở rộng ra ngoài bài hiện tại của em một chút: trường hợp như sau:
- Đặt ra trường hợp: trên Sheet ChiTiet nếu cần lookup những giá trị trên một trong các cột A, B, C, D, E của LLNV theo SỐ THẺ thì có thể Lookup được không bác? Nếu được thì code sẽ thay đổi như thế nào?
- Nếu ở Sheet LLNV phần SỐ THẺ (hay còn gọi là mã số Nhân Viên) nằm ở cột F chẳng hạn, và ở các cột A, B, C, D, E vẫn có dữ liệu liên quan.
Trong file đính kèm em có thay đổi thứ tự một số cột để phù hợp với nội dung em hỏi thêm. Sheet LLNV vẫn là DATA gốc.
- Nếu cột cần lookup ở Sheet Chitiet nằm ở bên trái của cột SỐ THẺ thì cần thay đổi code thế nào cho phù hợp ạ?
Cám ơn Bác ndu96081631 cùng các AE GPE đã quan tâm, giúp đỡ và chia sẻ.
Mong bác cùng mọi người dành thêm chút thời gian cho phần em hỏi thêm.
Em cảm ơn bác ndu96081631 Quả thực em chẳng biết gì về VBA, em đã nghiên cứu bài viết của bác, đã ứng dụng vào bài của em nhưng không được. Rất mong bác bỏ chút thời gian giúp em bài toán này. Em gửi file đính kèm, bác giúp em nhé. Em cảm ơn bác nhiều.Đây là thiếu sót của tất cả các code từ đầu topic đến giờ
Dùng sự kiện Worksheet_Change phải biết rằng Target không phải luôn là 1 cell ---> Đôi khi ngươi ta copy/paste( hoặc quét chọn khối cell rồi Delete như bạn làm) thì sao?
Chính vì thế phải cho thêm công đoạn quét toàn bộ các cell thuộc Target (For Each Clls in Target chẳng hạn)
Nói chung dạng bài này cũng đã từng post trên diễn đàn rồi... nếu khéo léo, có thể dùng Array để tăng tốc bảng tính
Các bạn khác đang nghiên cứu về VBA code thừ cải tiến lại xem
(tôi làm hoài dạng này đâm chán luôn)
--------------------------------------
Đây chính là lúc dùng đến Dictionary nè!
Tuy nhiên, nếu khéo hơn thì ta chỉ tạo và nạp Dictionary 1 lần duy nhất (nếu Dictionary chưa được tạo) ---> Những lần sau đó của sự kiện Change, chỉ việc "vào" Dic "moi" ra xài thôi
Sửa code bài 45 lại tí thôi mà (sửa tham chiếu cho phù hợp dữ liệu của bạn)Em cảm ơn bác ndu96081631 Quả thực em chẳng biết gì về VBA, em đã nghiên cứu bài viết của bác, đã ứng dụng vào bài của em nhưng không được. Rất mong bác bỏ chút thời gian giúp em bài toán này. Em gửi file đính kèm, bác giúp em nhé. Em cảm ơn bác nhiều.
Em cảm ơn bác, vậy mà em mò mẫm mãi không được. Có một vấn đề nữa nhờ bác chỉ giúp. Giả sử file trên có nhiều sheet CT, CT1, CT2,....CTn. Sửa code trong sheet 'MA' như thế nào để khi thay đổi giá trị trong sheet 'MA' thì các giá trị tương ứng trong Sheet CT, CT1, CT2,...,CTn cũng thay đôi theo. Thank bác nhiều.Sửa code bài 45 lại tí thôi mà (sửa tham chiếu cho phù hợp dữ liệu của bạn)
Xem file
Để khỏi mất công làm hoài, bạn đưa file chuẩn nhất (mà bạn đang dùng) lên đây nhéEm cảm ơn bác, vậy mà em mò mẫm mãi không được. Có một vấn đề nữa nhờ bác chỉ giúp. Giả sử file trên có nhiều sheet CT, CT1, CT2,....CTn. Sửa code trong sheet 'MA' như thế nào để khi thay đổi giá trị trong sheet 'MA' thì các giá trị tương ứng trong Sheet CT, CT1, CT2,...,CTn cũng thay đôi theo. Thank bác nhiều.
Em cảm ơn bác, nhờ bác sửa giúp em với.Để khỏi mất công làm hoài, bạn đưa file chuẩn nhất (mà bạn đang dùng) lên đây nhé
Ái chà... File của bạn rối như tơ vò... nhìn vào tôi chẳng biết phải dùng sự kiện Change như thế nào, tại các cell nào nữa đâyEm cảm ơn bác, nhờ bác sửa giúp em với.
http://www.mediafire.com/?rvx4a6k1lnyr398
Hì, cảm ơn bác. Vậy bác xử lý cái cũ giúp em vậy nhé.Ái chà... File của bạn rối như tơ vò... nhìn vào tôi chẳng biết phải dùng sự kiện Change như thế nào, tại các cell nào nữa đây
Chào các bạnPHP:Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Range("B4:B99")) Is Nothing Then Dim Rng As Range, sRng As Range, Sh As Worksheet Set Sh = ThisWorkbook.Worksheets("MA") Set Rng = Sh.Range(Sh.[b2], Sh.[b2].End(xlDown)) Set sRng = Rng.Find(Target.Value, , xlFormulas, xlWhole) If sRng Is Nothing Then MsgBox "Nothing" Else Target.Offset(, 1).Resize(, 2).Value = sRng.Offset(, 1).Resize(, 2).Value End If End If End Sub
Option Explicit
Sub GPE()
Dim Rng As Range, sRng As Range, Sh As Worksheet
Set Sh = ThisWorkbook.Worksheets("MA")
Set Rng = Sh.Range(Sh.[b2], Sh.[b2].End(xlDown))
Set sRng = Rng.Find(Selection.Value, , xlFormulas, xlWhole) '<=|'
If sRng Is Nothing Then
Target.Offset(, 1).Value = "Nothing"
Else
Target.Offset(, 1).Resize(, 2).Value = sRng.Offset(, 1).Resize(, 2).Value
End If
End Sub
Em đã chép code trên vào module, nhập thử số liệu vào cột Mã của trang "Chitiet", nhấn Alt+F8 để run GEP thì bị báo lỗi chỗ Target[Thongbao]Vẫn File ở bài 1 và code trên
Bây giờ mình kg muốn sử dụng sự kiện Sub Worksheet_Change mà muốn sửa code để ở module, để khi muốn chạy code thì chọn nó để run, mong các bạn chỉ giúp; Cảm ơn cả nhà[/Thongbao]
Bạn kích hoạt ô chứa mã NV & chạy cái ni:
PHP:Option Explicit Sub GPE() Dim Rng As Range, sRng As Range, Sh As Worksheet Set Sh = ThisWorkbook.Worksheets("MA") Set Rng = Sh.Range(Sh.[b2], Sh.[b2].End(xlDown)) Set sRng = Rng.Find(Selection.Value, , xlFormulas, xlWhole) '<=|' If sRng Is Nothing Then Target.Offset(, 1).Value = "Nothing" Else Target.Offset(, 1).Resize(, 2).Value = sRng.Offset(, 1).Resize(, 2).Value End If End Sub
Chào các bạn
Vẫn File ở bài 1 và code trên
Bây giờ mình kg muốn sử dụng sự kiện Sub Worksheet_Change mà muốn sửa code để ở module, để khi muốn chạy code thì chọn nó để run, mong các bạn chỉ giúp
Cảm ơn cả nhà
Sub Main()
Update Sheets("CT").Range("B4:B1000")
End Sub
Bạn nhấn vào nút Đổi sang khung lớn, sẽ nhìn thấy nút lệnh đính kèm file trên thanh công cụ soạn thảo.Bạn giúp viết code VBA cho hàm Tìm Kiếm giúp mình cho file đính kèm sau
Cám ơn
cách gửi file đính kèm thế nào?
Chào bác concogia và các cao thủ.
EM đang cần làm 1 cái phiếu xuất kho cũng thay thế hàm vlookup bằng mã VBA, copy mã của bác concogia về chạy thử thì rất ok. Chỉ có điều em muốn link thêm giá trị từ Sheet 'MA' sang sheet 'CT', mà ko biết sửa thế nào nhờ bác concogia và các cao thủ sử giúp. Em xin cảm ơn các bác.
Cho e hỏi thêm các thầy/anh/chị chútPHP:Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Range("B4:B99")) Is Nothing Then Dim Rng As Range, sRng As Range, Sh As Worksheet Set Sh = ThisWorkbook.Worksheets("MA") Set Rng = Sh.Range(Sh.[b2], Sh.[b2].End(xlDown)) Set sRng = Rng.Find(Target.Value, , xlFormulas, xlWhole) If sRng Is Nothing Then MsgBox "Nothing" Else Target.Offset(, 1).Resize(, 2).Value = sRng.Offset(, 1).Resize(, 2).Value End If End If End Sub
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("B4:B99")) Is Nothing Then
Dim Rng As Range, sRng As Range, Sh As Worksheet
Const GD As String = "_" '<=|'
Set Sh = ThisWorkbook.Worksheets("MA")
Set Rng = Sh.Range(Sh.[b2], Sh.[b2].End(xlDown))
Set sRng = Rng.Find(GD & Target.Value, , xlFormulas, xlWhole) '<=|'
If sRng Is Nothing Then
MsgBox "Nothing"
Else
Target.Offset(, 1).Resize(, 2).Value = sRng.Offset(, 1).Resize(, 2).Value
End If
End If
End Sub
Hình như cái ký tự do hệ thống tạo ra nó ko phải nút Shift - bình thường thì phải, e cố thẻ thay thế mà ko có đượcPHP:Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Range("B4:B99")) Is Nothing Then Dim Rng As Range, sRng As Range, Sh As Worksheet Const GD As String = "_" '<=|' Set Sh = ThisWorkbook.Worksheets("MA") Set Rng = Sh.Range(Sh.[b2], Sh.[b2].End(xlDown)) Set sRng = Rng.Find(GD & Target.Value, , xlFormulas, xlWhole) '<=|' If sRng Is Nothing Then MsgBox "Nothing" Else Target.Offset(, 1).Resize(, 2).Value = sRng.Offset(, 1).Resize(, 2).Value End If End If End Sub
Thử xem sao nha bạn!
E chưa hiểu lắm về 2 dòng code này, mong anh giải thíchPHP:Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Range("B4:B99")) Is Nothing Then Dim Rng As Range, sRng As Range, Sh As Worksheet Const GD As String = "_" '<=|' Set Sh = ThisWorkbook.Worksheets("MA") Set Rng = Sh.Range(Sh.[b2], Sh.[b2].End(xlDown)) Set sRng = Rng.Find(GD & Target.Value, , xlFormulas, xlWhole) '<=|' If sRng Is Nothing Then MsgBox "Nothing" Else Target.Offset(, 1).Resize(, 2).Value = sRng.Offset(, 1).Resize(, 2).Value End If End If End Sub
Thử xem sao nha bạn!
E chưa hiểu lắm về 2 dòng code này, mong anh giải thích
(1) Set Rng = Sh.Range(Sh.[b2], Sh.[b2].End(xlDown))
(2)Target.Offset(, 1).Resize(, 2).Value = sRng.Offset(, 1).Resize(, 2).Value
Không hiểu sao nó lại ra NOTHING ạhPHP:Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Range("B4:B99")) Is Nothing Then Dim Rng As Range, sRng As Range, Sh As Worksheet Const GD As String = "_" '<=|' Set Sh = ThisWorkbook.Worksheets("MA") Set Rng = Sh.Range(Sh.[b2], Sh.[b2].End(xlDown)) Set sRng = Rng.Find(GD & Target.Value, , xlFormulas, xlWhole) '<=|' If sRng Is Nothing Then MsgBox "Nothing" Else Target.Offset(, 1).Resize(, 2).Value = sRng.Offset(, 1).Resize(, 2).Value End If End If End Sub
Thử xem sao nha bạn!
1 If sRng Is Nothing Then
MsgBox "Nothing"
3 Else
Target.Offset(, 1).Resize(, 2).Value = sRng.Offset(, 1).Resize(, 2).Value
5 End If
Cái chú thích này '<=|'PHP:Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Range("B4:B99")) Is Nothing Then Dim Rng As Range, sRng As Range, Sh As Worksheet Const GD As String = "_" '<=|' Set Sh = ThisWorkbook.Worksheets("MA") Set Rng = Sh.Range(Sh.[b2], Sh.[b2].End(xlDown)) Set sRng = Rng.Find(GD & Target.Value, , xlFormulas, xlWhole) '<=|' If sRng Is Nothing Then MsgBox "Nothing" Else Target.Offset(, 1).Resize(, 2).Value = sRng.Offset(, 1).Resize(, 2).Value End If End If End Sub
Thử xem sao nha bạn!
E bôi đen một mảng mã, copy vào Range B2:B99 thì báo lỗi ạh, có giải pháp nào tốt hơn ko ạhPHP:Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Range("B4:B99")) Is Nothing Then Dim Rng As Range, sRng As Range, Sh As Worksheet Const GD As String = "_" '<=|' Set Sh = ThisWorkbook.Worksheets("MA") Set Rng = Sh.Range(Sh.[b2], Sh.[b2].End(xlDown)) Set sRng = Rng.Find(GD & Target.Value, , xlFormulas, xlWhole) '<=|' If sRng Is Nothing Then MsgBox "Nothing" Else Target.Offset(, 1).Resize(, 2).Value = sRng.Offset(, 1).Resize(, 2).Value End If End If End Sub
Thử xem sao nha bạn!
Đưa nguyên cái file bị lỗi lên xem sao. Nói rõ khi nào thì lỗi.E bôi đen một mảng mã, copy vào Range B2:B99 thì báo lỗi ạh, có giải pháp nào tốt hơn ko ạh
Thật ra tôi rất thích tranh luận để chứng minh vấn đề
Vậy thay vì nói suông ta làm cuộc thí nghiệm với 10000 dòng dữ liệu giữa code của tôi VS với VLOOKUP nhé (xem file)
Tại sheet ChiTiet, điền dữ liệu vào cột C rồi lookup 16 cột còn lại bên phải
Code của tôi như sau:
PHP:Private Sub Worksheet_Change(ByVal Target As Range) Dim rTarget As Range, aTarget, i As Long, j As Long, n As Long, TG As Double Dim Arr(), tmp On Error Resume Next TG = Timer If Dic Is Nothing Then Auto_Open If Not Intersect(Range("C6:C65536"), Target) Is Nothing Then Set rTarget = Intersect(Range("C6:C65536"), Target) If IsArray(rTarget.Value) Then aTarget = rTarget.Value Else ReDim aTarget(1 To 1, 1 To 1) aTarget(1, 1) = rTarget.Value End If ReDim Arr(1 To UBound(aTarget, 1), 1 To 17) For i = 1 To UBound(aTarget, 1) If aTarget(i, 1) <> "" Then tmp = aTarget(i, 1) If Dic.Exists(tmp) Then For j = 2 To 17 Arr(i, j - 1) = aResult(Dic.Item(tmp), j) Next End If End If Next rTarget.Offset(, 1).Resize(, 16).Value = Arr MsgBox Timer - TG End If End Sub
Bác ndu cho em hỏi nếu sử dụng code này nhưng số luợng tới 170.000 dòng thì phải sửa sao vậy ta? em thử sửa C6:C65536 --> C6:C170000 nhưng chẳng ăn thua, khi copy/paste như hướng dẫn thì từ dòng 117.000 trở đi nó ko ra kết quả nữa
Coi chừng bị nhầm à anh TrungChinh, người hỏi là 170.000 dòng lớn hơn 65.536 đó.Tôi thấy code của Ndu có tác dụng tới dòng thứ 65536 nên bạn cứ thế mà xài, chẳng cần phải sửa gì cả.
Xin chào các Anh Chị GPE,
Sau khi đọc chủ đề này mình có câu hỏi thế này.
- File của anh "ndu96081631": Khi mình thay đổi nội dung ở Sheet LLNV thì Sheet Chi Tiết không tự động chạy theo nội dung mới mà phải F2 cột mã NV rồi Enter thì giá trị mới cập nhật.>> Mình muốn nó tự động cập nhật như Vlookup luôn.
- Trong trường hợp này là Data chung 1 file excel, nếu như Sheet LLNV nằm trong 1 file khác (Ví dụ có tên DATA.xls) thì code mình phải thay đổi thế nào ạ.
Mong các Anh Chị GPE giải đáp giúp nha.
Cảm ơn Anh Chị rất nhiều.
yêu câu thứ 1: khi thay đổi bất kỳ bên sheet "LLNV" thì sheet "chitiet" cập nhật theo (giống tính năng của hàm vlookup)
cái này có thể sử dụng find method trong sự kiện worksheet change cho sheet "LLNV"
tuy nhiên cho hỏ là: các mã cột C của sheet "chi tiet" có trùng nhau ko?
câu hỏi 2: nếu nằm ở file khác thì phức tạp hơn là phải mở file đó ra rồi dùng phương pháp Find
(hoặc dùng ADO, cái này thì tôi chỉ biết là vậy chứ chưa biết làm)
- Trong trường hợp của em thì có, mã code sẽ được lặp lại nhiều lần, phần này em chỉ cần nó auto update như vlookup là ok.
- Cũng có nghe nói ADO nhưng không biết nó thế nào luôn.. Mong các Anh Chị chỉ giáo, nếu mà có thể chọn file làm data như trong Vlookup thì hay biết mấy (Vlookup xong mình có thể chọn Edit link và chọn vào 1 file khác tương tự). Vì File Data của em mỗi khi cập nhật giá là thêm 1 số (Ví dụ Data1 , Data2 ....)
Trong file của anh, khi thay đổi Tên thì ok, có thể thay đổi theo, nhưng khi thay đổi Ngày vào bên LLNV thì cột mã code bên sheet Chi Tiet chạy số tùm lum.yêu cầu thứ 1 (để điều chỉnh lại vị trí các cột)
Trong file của anh, khi thay đổi Tên thì ok, có thể thay đổi theo, nhưng khi thay đổi Ngày vào bên LLNV thì cột mã code bên sheet Chi Tiet chạy số tùm lum.
Anh fix lại giúp.
Sub update()
[COLOR=#ff0000]Application.ScreenUpdating = False[/COLOR]
.......................................................
[COLOR=#ff0000]Application.ScreenUpdating = True[/COLOR]
End Sub
lúc chiều tôi mới test xong một c ột, như hết giờ làm nên đi về...........post lên đó về nhà làm tiếp
đã làm lại cho bạn,....vào test thử
=================
nếu bạn có tải về thì bỏ dùm tôi 2 dòng lệnh
ở sub update, nó ko giúp ích gì, chỉ gây màn hình giật giậtMã:Sub update() [COLOR=#ff0000]Application.ScreenUpdating = False[/COLOR] ....................................................... [COLOR=#ff0000]Application.ScreenUpdating = True[/COLOR] End Sub
PHP:Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Range("B4:B99")) Is Nothing Then Dim Rng As Range, sRng As Range, Sh As Worksheet Set Sh = ThisWorkbook.Worksheets("MA") Set Rng = Sh.Range(Sh.[b2], Sh.[b2].End(xlDown)) Set sRng = Rng.Find(Target.Value, , xlFormulas, xlWhole) If sRng Is Nothing Then MsgBox "Nothing" Else Target.Offset(, 1).Resize(, 2).Value = sRng.Offset(, 1).Resize(, 2).Value End If End If End Sub
Em đã thử áp dụng code của anh CONCOGIA mà không được. Mong các anh giúp đỡ em ạ.
Em đã thử cho vao không được nên em đã xóa đi. Anh hướng dẫn giúp em được không ạ,Trong file có code nào đâu mà biết tại sao?
Cảm ơn bác rất nhiều về code này. Nhưng em thay vì nhập liệu vào sheet CT mà em có danh sách sẵn từ copy - pate vào nó ko chạy được anh ạ, phải nhấn F2 sửa rồi enter nó mới ra. Bác xem giúp em sửa thế nào với ạSửa code bài 45 lại tí thôi mà (sửa tham chiếu cho phù hợp dữ liệu của bạn)
Xem file
Tôi chưa hiểu ý bạn muốn hỏi jmò mấy ngày rồi cũng chưa hiểu gì, tuy nhiên xào nấu mò theo ý được rồi, chỉ còn 1 thắc mắc là cái library mình để ở 1 workbook khác được không? vì cái đó thường liên quan đến dữ lieu giá của công ty, không tiện gửi file lên, các anh chị thhông cảm cho hỏi chay thôi ạ
Bạn thử dùng code này xem sao:mình chỉnh lại cái nguồn vì lí do cá nhân nha,, chỉ là mỗi lần tính giá xong lại phải ngồi xóa công thức, xóa bang giá ....,
giờ trước tiên chỉ muốn vlookup cái diễn giải trước thôi
Sub TimKiem()
Dim i&, Rng As Range, Data(), DienGiai()
Data = Range(Sheet9.[A24], Sheet9.[A1000].End(3))
ReDim DienGiai(1 To UBound(Data), 1 To 1)
For i = 1 To UBound(Data)
Set Rng = Sheet11.[B2:B50].Find(Data(i, 1), , , 1)
If Not Rng Is Nothing Then
DienGiai(i, 1) = Rng.Offset(, 2)
End If
Next
Sheet9.[B24].Resize(i - 1, 1) = DienGiai
End Sub
Em thử áp dụng các code trong bài nhưng vẫn chưa dùng được như hàm vlookup
Em có 1 sheet khai báo nhân viên tương ứng ở nhóm nào
Em muốn khi nhập liệu chỉ nhập tên nhân viên thì cột nhóm tự động lấy bên sheet khai báo
Chi tiết ở file đính kèm
Kính nhờ anh chị hỗ trợ giúp em với ah
Em cám ơn
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range
If Not Intersect(Target, [b4:b100]) Is Nothing Then
Set rng = Sheets("Boloc").[b:b].Find(Target, , , 1)
If Not rng Is Nothing Then Target.Offset(, 1) = rng.Offset(, 1)
End If
End Sub
Option Explicit
Sub VLookUp()
Dim Sh As Worksheet, CSDL As Range, Cls As Range
Dim Rws As Long
Set Sh = ThisWorkbook.Worksheets("DATA")
Set CSDL = Sh.[B2].CurrentRegion
If [B2].Parent.Name = "DATA" Then
MsgBox "Hay Chon Trang Khác!": Exit Sub
End If
For Each Cls In Range([c4], [c4].End(xlDown))
Cls.FormulaR1C1 = _
"=IF(TYPE(VLOOKUP(RC[-1],DATA!R2C1:R27C4,2,0))=16,"""",VLOOKUP(RC[-1],DATA!R2C1:R27C4,2,0))"
Next Cls
End Sub