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 Featured content 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 đề Note 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 Thread starter hoangvinh_tb
• Ngày gửi 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 vlookup.xls 24.5 KB · Đọc: 2,152

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,567 Được thích 22,872 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 340 Được thích 244 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 vlookup (2).xls 37 KB · Đọc: 854

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 340 Được thích 244 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

N

• Question Question

Cần giúp rút gọn code vba

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

Trả lời 3 Đọc 80 Hôm qua, lúc 21:24 VetMini V Lỗi khi COPY , viền xung quanh ô được chọn đứng yên, không chạy

• • 

• dungdodac
• 17/12/24
• Hỏi đáp những vấn đề khác

Trả lời 4 Đọc 178 Hôm qua, lúc 21:17 VetMini V B Xin hàm đếm số lượng khách hàng theo 1 điều kiện và bỏ dữ liệu trùng.

• bipbo2008
• 15/12/24
• Hàm và công thức Excel

Trả lời 10 Đọc 335 Hôm qua, lúc 20:22 Phan Thế Hiệp

• Question Question

Xin giúp chuyển dữ liệu từ cột dọc sang hàng ngang theo điều kiện

• • 

• Manhhung90
• Hôm qua, lúc 19:22
• Lập Trình với Excel

Trả lời 1 Đọc 33 Hôm qua, lúc 19:30 Hoàng Tuấn 868 H X Tự động giãn dòng và ẩn các dòng bị bỏ trống

• xuanthucle
• Hôm qua, lúc 17:59
• Giải thích, gỡ rối, xử lý lỗi công thức

Trả lời 0 Đọc 20 Hôm qua, lúc 17:59 xuanthucle X

• Đã giải quyết

ExplorerXL - Quản lý thư mục với Excel: tìm, đổi tên, sao chép, di chuyển và xóa

• • 
  • 
  • 

• HeSanbi
• 20/9/19
• Lập Trình với Excel

2 3 4 Trả lời 79 Đọc 16K Hôm qua, lúc 17:11 viethung78 V H Giao diện mới ở "chế độ tối" mờ quá

• • 
  • 

• HieuCD
• Hôm qua, lúc 12:27
• Những góp ý với diễn đàn

Trả lời 4 Đọc 89 Hôm qua, lúc 16:48 OverAC J quản lý dữ liệu theo cách quản lý bãi container

• • 

• jack nt
• 5/4/13
• Xây dựng ứng dụng.

Trả lời 2 Đọc 7K Hôm qua, lúc 15:29 vunhai V

• Question 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

13 14 15 Trả lời 298 Đọc 20K Hôm qua, lúc 14:26 ongke0711 M Sắp xếp dữ liệu: Lọc tên theo ABC (alphabet) có lỗi tên Đam đứng trước Diệp

• mrhh
• 6/1/22
• Lọc và sắp xếp dữ liệu

Trả lời 13 Đọc 5K Hôm qua, lúc 12:31 maidinhdung5 S Tính trung bình của tháng đầu tiên.

• SteveNguyen1991
• Chủ nhật lúc 21:36
• Hàm và công thức Excel

Trả lời 1 Đọc 140 Hôm qua, lúc 09:27 Phan Thế Hiệp Hàm BS_FORMATTEXT Tạo công thức định dạng văn bản trong Excel với Add-in A-Tools v10

• Nguyễn Duy Tuân
• Hôm qua, lúc 09:05
• BLUESOFTS: A-Excel, A-Tools

Trả lời 0 Đọc 33 Hôm qua, lúc 09:05 Nguyễn Duy Tuân Hàm BS_TEXT trộn văn bản trong Excel với Add-in A-Tools v10

• Nguyễn Duy Tuân
• Hôm qua, lúc 08:36
• BLUESOFTS: A-Excel, A-Tools

Trả lời 0 Đọc 31 Hôm qua, lúc 08:36 Nguyễn Duy Tuân Nhật ký thi công bằng excel

• • 

• aduc
• 27/10/13
• Excel và Kỹ Thuật

2 Trả lời 36 Đọc 53K Hôm qua, lúc 08:35 PhanTuHuong T

• Question Question

Xin code VBA trả về tên tài khoản theo điều kiện

• • 

• Thanh Binh111
• Thứ sáu lúc 16:40
• Lập Trình với Excel

Trả lời 8 Đọc 152 Chủ nhật lúc 21:02 ptm0412 xin cách lọc này với ạ.

• likosin
• Thứ sáu lúc 09:53
• Lọc và sắp xếp dữ liệu

Trả lời 4 Đọc 132 Chủ nhật lúc 20:58 ptm0412 [Thông báo] Diễn đàn tạm ngừng hoạt động để bảo trì từ 21g thứ Sáu ngày 20/12

• • 
  • 

• OverAC
• Thứ năm lúc 22:13
• Thông tin về diễn đàn

Trả lời 1 Đọc 932 Chủ nhật lúc 14:18 OverAC A Nhờ xử lý tính toán Số nằm trong chuỗi kí tự

• acrox84
• 15/12/24
• Xử lý chuỗi ký tự

2 Trả lời 20 Đọc 560 Thứ sáu lúc 20:35 SteveNguyen1991 S V

• Question Question

FILE EXCEL LOI : WE FOUND A PROBLEM ... RECOVER

• vuasutu08
• Thứ sáu lúc 16:03
• Lập Trình với Excel

Trả lời 0 Đọc 73 Thứ sáu lúc 16:03 vuasutu08 V D

• Question Question

Gửi Email chào giá hàng loạt cho đối tác có nhúng 1 bảng báo giá vào mail

• ductoan.0703
• Thứ tư lúc 14:49
• Lập Trình với Excel

Trả lời 3 Đọc 189 Thứ sáu lúc 15:12 BuiQuangThuan B Xem thêm… Chia sẻ: Facebook X (Twitter) LinkedIn 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 30
• HeSanbi 27
• LINHCM 25
• ptm0412 24
• hoangtuaotrang_hp_vn 21
• HieuCD 19
• ongke0711 18
• SA_DQ 18
• qtm1987 17
• huuthang_bd 16
• DeTong 15
• hvnhpro 13
• hoangminhtien 13
• BuiQuangThuan 13
• HUONGHCKT 12
• SteveNguyen1991 11
• Duy Tùng 9x 10
• GPE-Trợ Lý 9
• Nguyễn Duy Tuân 9
• befaint 8

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

• HieuCD 74
• huuthang_bd 34
• Hoàng Tuấn 868 32
• hoangtuaotrang_hp_vn 28
• hoangminhtien 24
• SA_DQ 24
• HeSanbi 23
• HUONGHCKT 22
• befaint 22
• DeTong 22
• GPE-Trợ Lý 21
• ptm0412 21
• ongke0711 15
• longtay1111 13
• Hai Lúa Miền Tây 13
• NT Ngoc Yen 12
• Phuocam 12
• Nguyễn Duy Tuân 11
• Phan Thế Hiệp 11
• OverAC 10

Đếm ngược thời gian

000 Ngày 00 Giờ 00 phút 00 giây Chúc mừng năm mới

• 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