Xin Viết Dùng Mã Vba Thay Thế Cho Hàm Vlookup | Giải Pháp Excel

• Trang chủ Có gì mới Hoạt động gần nhất Tác giả
• Diễn đàn Tìm bài viết mới Tìm theo chuyên mục
• Video Video về Excel Video về tin học khác Tin tức về tin học chung
• Thông tin mới Tìm bài mới Tài Nguyên Mới Hoạt động gần nhất
• Tài nguyên Đánh giá mới nhất Tìm tài nguyên
• Facebook
• Đóng góp

Đăng nhập Đăng Ký Có gì mới? Tìm kiếm

Tìm kiếm

Mọi nơi Đề tài Diễn đàn này Đề tài này Chỉ tìm trong tiêu đề Bởi: Tìm kiếm Tìm nâng cao…

• Tìm bài viết mới
• Tìm theo chuyên mục

Menu Đăng nhập Đăng Ký Install the app Install How to install the app on iOS

Follow along with the video below to see how to install our site as a web app on your home screen.

Note: This feature may not be available in some browsers.

• Khách ơi! GPE thông tin đến bạn ấn phẩm "lập trình VBA trong Excel": - Phần cơ bản - Phần Nâng Cao - VBA trong Excel - Cải thiện và tăng tốc

• Trang chủ
• Diễn đàn
• Excel và các ngôn ngữ lập trình khác
• Excel và các ngôn ngữ lập trình khác

You are using an out of date browser. It may not display this or other websites correctly.You should upgrade or use an alternative browser. Xin viết dùng mã vba thay thế cho hàm vlookup

• Thread starter hoangvinh_tb
• Ngày gửi 4/4/12

• 1
• 2
• 3
• …

  Go to page

  Tiếp tục
• 14

Tiếp 1 of 14

Go to page

Tiếp tục Tiếp Last H

hoangvinh_tb

Thành viên mới

Tham gia 16/6/08 Bài viết 20 Được thích 4 Mì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!!!

File đính kèm

• vlookup.xls 24.5 KB · Đọc: 2,151

concogia

Gội rồi mới Cạo

Tham gia 17/9/09 Bài viết 3,412 Được thích 6,876

hoangvinh_tb đã viết: Mì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!!! Nhấp chuột vào đây để mở rộng...

Mã nó đây RightClick vào sheet "CT" ==> View Code chép cái này vào Mã:Sao chép. 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 Thân

SA_DQ

/(hông là gì!

Thành viên danh dự Tham gia 8/6/06 Bài viết 14,538 Được thích 22,815 Nghề nghiệp U80 Cái ni cũng vừa đủ sòai nề PHP:Sao chép. 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 H

hoangvinh_tb

Thành viên mới

Tham gia 16/6/08 Bài viết 20 Được thích 4 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

TrungChinhs

Thành viên tích cực

Tham gia 18/2/08 Bài viết 1,475 Được thích 2,469 Nghề nghiệp Công chức

hoangvinh_tb đã viết: 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 Nhấp chuột vào đây để mở rộng...

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. H

hoangvinh_tb

Thành viên mới

Tham gia 16/6/08 Bài viết 20 Được thích 4

TrungChinhs đã viết: 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. Nhấp chuột vào đây để mở rộng...

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. K

khongphai02

Thành viên mới

Tham gia 7/4/12 Bài viết 15 Được thích 2

concogia đã viết: Mã nó đây RightClick vào sheet "CT" ==> View Code chép cái này vào Mã:Sao chép. 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 Thân Nhấp chuột vào đây để mở rộng...

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é. Q

qtm1987

Thành viên thường trực

Tham gia 15/9/09 Bài viết 322 Được thích 231 Nghề nghiệp Kế toán tổng hợp

concogia đã viết: Mã nó đây RightClick vào sheet "CT" ==> View Code chép cái này vào Mã:Sao chép. 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 Thân Nhấp chuột vào đây để mở rộng...

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:Sao chép. 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 Lần chỉnh sửa cuối: 13/4/12 K

khongphai02

Thành viên mới

Tham gia 7/4/12 Bài viết 15 Được thích 2 Sửa giúp em cái này với Bác 'CONCOGIA'

concogia đã viết: Mã nó đây RightClick vào sheet "CT" ==> View Code chép cái này vào Mã:Sao chép. 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 Thân Nhấp chuột vào đây để mở rộng...

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.

File đính kèm

• vlookup (2).xls 37 KB · Đọc: 852

concogia

Gội rồi mới Cạo

Tham gia 17/9/09 Bài viết 3,412 Được thích 6,876

qtm1987 đã viết: 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:Sao chép. 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 Nhấp chuột vào đây để mở rộng...

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ả Cách của bạn là 2 vòng ......lồng vào nhau, dữ liệu càng lớn thì tốc độ càng của nó làm bạn........."hao thuốc lá + cà phê đá" Mình chỉ nghĩ thế thôi ( trên lý thuyết) vì không có file thực tế để thử ( làm biếng tạo file quá ) Thân

concogia

Gội rồi mới Cạo

Tham gia 17/9/09 Bài viết 3,412 Được thích 6,876

khongphai02 đã viết: 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. Nhấp chuột vào đây để mở rộng...

Bạn chép code này đè lên cái cũ nhé Mã:Sao chép. 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 Thân K

khongphai02

Thành viên mới

Tham gia 7/4/12 Bài viết 15 Được thích 2

khongphai02 đã viết: 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. Nhấp chuột vào đây để mở rộng...

m mò ra rồi, Cảm ơn các bác 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(, 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 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 If End Sub Các bác chỉ giúp em với xem có sai ko/ thanks S

siwtom

Thành viên gắn bó

Tham gia 19/3/08 Bài viết 2,127 Được thích 4,210

concogia đã viết: Bạn chép code này đè lên cái cũ nhé Mã:Sao chép. 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 Thân Nhấp chuột vào đây để mở rộng...

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ã:Sao chép. 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. T

tiendo1988

Thành viên chính thức

Tham gia 6/8/09 Bài viết 82 Được thích 11

siwtom đã viết: 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ã:Sao chép. 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. Nhấp chuột vào đây để mở rộng...

Mặc dừ tôi chưa biết sử dụng các code lệnh xong tôi xin có vài ý kiến để các bác xem xét: tôi thấy code của siwtom và code của concogia đều ngắn gọn và đã đáp ứng được việc hiển thị thông tin trong các cột Sản phẩm, đơn vị, đơn giá khi nhập mã vào cột MA ở Sheet CT. Xong khi ta xóa các mã ở một dòng bất kỳ thì trên cột MA thì những thông tin ở các cột bên vẫn còn nguyên không bị mất. Các Pro có thể bổ sung thêm để đáp ứng yêu cầu khi xóa trên cột MA thì các thông tin về tên sản phẩm, đơn vị, đơn giá cùng biến mất. Các Pro thông thạo về VBA bớt chút thời gian giúp em Topic Trợ giúp CODE VBA để thay thế cho hàm Vlookup Lần chỉnh sửa cuối: 14/4/12 Q

qtm1987

Thành viên thường trực

Tham gia 15/9/09 Bài viết 322 Được thích 231 Nghề nghiệp Kế toán tổng hợp

tiendo1988 đã viết: .... Xong khi ta xóa các mã ở một dòng bất kỳ thì trên cột MA thì những thông tin ở các cột bên vẫn còn nguyên không bị mất. Các Pro có thể bổ sung thêm để đáp ứng yêu cầu khi xóa trên cột MA thì các thông tin về tên sản phẩm, đơn vị, đơn giá cùng biến mất. Nhấp chuột vào đây để mở rộng...

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 ... T

tiendo1988

Thành viên chính thức

Tham gia 6/8/09 Bài viết 82 Được thích 11 Em đã thử thêm Code của Ban qtm1987 vào đoạn code của concogia theo hướng dẫn. Kết quả rất tốt. Em mới tiếp cận đến code nên chưa hiểu gì nhiều về các code sử dụng. Làm phiền các bác giải thích giúp em ý nghĩa của những code mà anh qtm1987 và concogia đã sử dụng để em hiểu hơn về code và có thể tùy biến vào bài của mình. Xin cảm ơn! K

khongphai02

Thành viên mới

Tham gia 7/4/12 Bài viết 15 Được thích 2

concogia đã viết: Bạn chép code này đè lên cái cũ nhé Mã:Sao chép. 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 Thân Nhấp chuột vào đây để mở rộng...

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. - Thứ nhất: Khi xóa mã ở Shet ‘CT’ thì các giá trị ‘Tên sp’; ‘ĐVT’, ‘Đơn giá’ vẫn giữ nguyên. (như bác ‘tiendo1988’ đã thắc mắc – bác ‘qtm1987’ đã bổ sung) - Thứ hai: Làm thế nào để khi thay đổi giá trị đơn giá ở Sheet ‘MA’ thì bên sheet CT sẽ tự động cập nhập đơn giá mới? Mong bác 'concogia', bác ‘qtm1987’ và các bác cao thủ giải quyết vấn đề này giúp em với. Thank các bác nhiều! Lần chỉnh sửa cuối: 14/4/12 K

khongphai02

Thành viên mới

Tham gia 7/4/12 Bài viết 15 Được thích 2

qtm1987 đã viết: 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 ... Nhấp chuột vào đây để mở rộng...

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'

ndu96081631

Huyền thoại GPE

Thành viên BQT Super Moderator Tham gia 5/6/08 Bài viết 30,703 Được thích 53,950

khongphai02 đã viết: 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' Nhấp chuột vào đây để mở rộng...

Đâ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) --------------------------------------

siwtom đã viết: 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 . Nhấp chuột vào đây để mở rộng...

Đâ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ần chỉnh sửa cuối: 14/4/12 T

tiendo1988

Thành viên chính thức

Tham gia 6/8/09 Bài viết 82 Được thích 11

ndu96081631 đã viết: Đâ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 Nhấp chuột vào đây để mở rộng...

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!

• 1
• 2
• 3
• …

  Go to page

  Tiếp tục
• 14

Tiếp 1 of 14

Go to page

Tiếp tục Tiếp Last Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.

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

B

• Question

Windows Form Làm thế nào để định vị cột và dòng nhập dữ liệu

• binhtv69
• Hôm qua, lúc 09:01
• Lập Trình với Excel

Trả lời 15 Đọc 197 Hôm nay lúc 14:23 ptm0412 Addin mở rộng cho xây dựng

• • 

• dangvandang
• 28/10/23
• Các Add-ins cho excel

2 Trả lời 26 Đọc 2K Hôm nay lúc 14:16 dangvandang Nhờ hướng dẫn các xử lý hiển thị

• noisy
• Hôm nay lúc 09:19
• Giải thích, gỡ rối, xử lý lỗi công thức

Trả lời 2 Đọc 75 Hôm nay lúc 10:37 ongke0711 D Xin chỉ giáo code VBA copy file csv , thay đổi tỉ giá và lưu file csv mới

• daoduy88
• Thứ năm lúc 12:01
• VBA trong Excel – Cải thiện và tăng tốc

Trả lời 11 Đọc 194 Hôm nay lúc 09:09 daoduy88 D H Nhờ hướng dẫn tạo bảng như hình vẽ

• hoaiantrinh
• Thứ tư lúc 16:32
• Hỏi đáp những vấn đề khác

Trả lời 6 Đọc 170 Hôm nay lúc 08:50 vansutk V K Biến động giữa 2 cột khi pivot table

• khzaof
• Hôm qua, lúc 23:45
• Pivot table

Trả lời 1 Đọc 49 Hôm nay lúc 08:35 ptm0412

• Question

Nhờ viết Code lấy dữ liệu tờ khai hải quan vào bảng tổng hợp

• Tienvinh191
• 4/4/24
• Lập Trình với Excel

2 Trả lời 29 Đọc 2K Hôm nay lúc 07:02 quyenpv L

• Question

Dùng vòng lặp để lọc dữ liệu sang sheet khác nhưng tìm dòng cuối không được

• lvh1064
• Thứ năm lúc 18:45
• Lập Trình với Excel

Trả lời 10 Đọc 282 Hôm qua, lúc 23:22 ptm0412

• Question

Cắt file PDF bằng Excel

• thaibao13d3bk
• 18/8/20
• Lập Trình với Excel

Trả lời 6 Đọc 2K Hôm qua, lúc 23:03 noname1710 Viết hoa toàn bài viết: HỎI CÁCH SỬ DỤNG CÔNG THỨC KHI BỊ CHE MẤT Ô LIỀN KỀ

• • 

• VUONGTNQN
• Hôm qua, lúc 22:26
• I. Nội dung bài viết

Trả lời 0 Đọc 81 Hôm qua, lúc 22:26 VUONGTNQN Bài tập excel tính thành tiền có đk

• bùi võ anh thư
• Hôm qua, lúc 00:15
• Hỏi đáp những vấn đề khác

Trả lời 10 Đọc 186 Hôm qua, lúc 20:55 ptm0412 làm bảng quản lý nhân viên sắp phải gia hạn hợp đồng

• LINHJP
• Hôm qua, lúc 13:30
• Định dạng, trình bày, in ấn bảng tính

Trả lời 2 Đọc 83 Hôm qua, lúc 20:00 HUONGHCKT H

• Question

Tải hóa đơn điện tử (https://hoadondientu.gdt.gov.vn/) Excel Vba

• • 
  • 

• ongke0711
• 6/10/24
• Lập Trình với Excel

11 12 13 Trả lời 258 Đọc 14K Hôm qua, lúc 19:07 huhumalu H

• Question

Xin giúp đỡ về cách định vị cột, dòng theo điều kiện

• ngdhan
• Hôm qua, lúc 10:14
• Lập Trình với Excel

Trả lời 7 Đọc 116 Hôm qua, lúc 17:06 HUONGHCKT H N Giúp sửa mã code

• Nguyễn Diêu Hiền
• 14/11/24
• Những vấn đề chung

2 Trả lời 22 Đọc 623 Hôm qua, lúc 16:21 Nguyễn Diêu Hiền N Q Bài toán về VBA - Tự động chuyển dữ liệu

• QL.GDHV2
• Hôm qua, lúc 15:44
• Hỏi đáp những vấn đề khác

Trả lời 3 Đọc 107 Hôm qua, lúc 16:20 BuiQuangThuan B T Cách thiết lập font chữ cố định cho bảng tính (không bị thay đổi khi mở ở máy tính khác)

• TRANTHEJP
• Hôm qua, lúc 14:46
• Định dạng, trình bày, in ấn bảng tính

Trả lời 0 Đọc 57 Hôm qua, lúc 14:46 TRANTHEJP T V

• Question

Giúp Code VBA lưu ảnh từ 1 link về Excel sao cho nhanh nhất

• Văn Toàn 1996
• Thứ năm lúc 15:49
• Lập Trình với Excel

Trả lời 7 Đọc 153 Hôm qua, lúc 13:32 befaint K Link ảnh từ thư mục tự động vào excel sử dụng VBA

• khactien.delta
• Thứ năm lúc 16:22
• Hàm và công thức Excel

Trả lời 3 Đọc 109 Hôm qua, lúc 12:28 Hoàng Tuấn 868 H

• Question

Hỗ trợ khắc phục lỗi Copy cùng 1 bảng tính sang nhiều vị trí trên Word bị lỗi Clipboard

• Toanke063
• Hôm qua, lúc 12:11
• Lập Trình với Excel

Trả lời 0 Đọc 55 Hôm qua, lúc 12:11 Toanke063 Xem thêm… Chia sẻ: Facebook X (Twitter) Reddit Pinterest Tumblr WhatsApp Email Chia sẻ Link

Thành viên có số lượng bài viết cao nhất tháng

• Hoàng Tuấn 868 150
• ptm0412 63
• VetMini 44
• ongke0711 35
• Tuấn Bụng Bự 31
• befaint 30
• bebo021999 29
• hoangtuaotrang_hp_vn 25
• BuiQuangThuan 25
• SA_DQ 25
• HeSanbi 24
• HUONGHCKT 24
• huuthang_bd 18
• huhumalu 17
• Nguyễn Diêu Hiền 15
• CHAOQUAY 14
• cantl 14
• DeTong 14
• Manhhung90 13
• phuongnam366377 13

Thành viên có điểm tương tác cao nhất tháng

• Hoàng Tuấn 868 122
• VetMini 62
• HeSanbi 60
• HUONGHCKT 50
• ptm0412 44
• ongke0711 43
• BuiQuangThuan 39
• befaint 36
• HieuCD 34
• SA_DQ 32
• huuthang_bd 31
• bebo021999 27
• hoangtuaotrang_hp_vn 25
• Phuocam 19
• huhumalu 15
• CHAOQUAY 12
• PhanTuHuong 12
• phuongnam366377 12
• Duy Tùng 9x 10
• DeTong 10

• Trang chủ
• Diễn đàn
• Excel và các ngôn ngữ lập trình khác
• Excel và các ngôn ngữ lập trình khác

• Website này sử dụng cookies. Tiếp tục sử dụng trang này, đồng nghĩa với việc bạn chấp nhận website sử dụng cookies. Chấp nhận Tìm hiểu thêm.…

Back Top Bottom