Tìm theo điều kiện bằng VBA

Liên hệ QC
J

jaispierre

Thành viên mới
Tham gia
3/6/08
Bài viết
37
Được thích
2
Em có dữ liệu gốc ở sheet1 và sheet2. Em muốn tạo 1 dữ liệu ở sheet 3 bao gồm tên ở sheet 1 theo cột dọc và nơi làm việc ở sheet 2 theo hàng ngang. Sau khi chạy code tìm kiếm bằng vba thì kết quả sẽ trả về giao điểm ở cột và hàng tại sheet3, giống như hàm index kết hợp với match ạ.
Bác nào xem giúp em với, file ví dụ đính kèm ạ
 

File đính kèm

  • Book1.xlsx
    11.5 KB · Đọc: 24
Sắp xếp theo thời gian sắp xếp theo bầu chọn
jaispierre đã viết:
Em có dữ liệu gốc ở sheet1 và sheet2. Em muốn tạo 1 dữ liệu ở sheet 3 bao gồm tên ở sheet 1 theo cột dọc và nơi làm việc ở sheet 2 theo hàng ngang. Sau khi chạy code tìm kiếm bằng vba thì kết quả sẽ trả về giao điểm ở cột và hàng tại sheet3, giống như hàm index kết hợp với match ạ.
Bác nào xem giúp em với, file ví dụ đính kèm ạ
Nhấp chuột vào đây để mở rộng...
Bạn có thể dùng CrossTab Query để giải bài toán này nhé.
 
Upvote 0
jaispierre đã viết:
kết quả sẽ trả về giao điểm ở cột và hàng tại sheet3
Nhấp chuột vào đây để mở rộng...
Thử
Mã: 
Sub Test()
  Dim a, b, i, lr1, lr2, c, k
  Dim dicName As Object, dicCity As Object
  Dim dArr
  Set dicName = CreateObject("Scripting.Dictionary")
  Set dicCity = CreateObject("Scripting.Dictionary")
With Sheets("Sheet1")
        lr1 = .Range("A" & Rows.Count).End(xlUp).Row
        a = .Range("A1:A" & lr1).Value
End With
        lr1 = UBound(a, 1)
        ReDim dArr(1 To lr1, 1 To 1)
        k = 1
            For i = 2 To lr1
                    If Not dicName.Exists(a(i, 1)) Then
                        k = k + 1
                        dicName.Add a(i, 1), k
                        dArr(k, 1) = a(i, 1)
                    End If
            Next
With Sheets("Sheet2")
        lr2 = .Range("A" & Rows.Count).End(xlUp).Row
        b = .Range("A2:B" & lr2).Value
End With
c = 1
            For i = 1 To UBound(b, 1)
                    If Not dicCity.Exists(b(i, 2)) Then
                        c = c + 1
                        ReDim Preserve dArr(1 To lr1, 1 To c)
                        dicCity.Add b(i, 2), c
                        dArr(1, c) = b(i, 2)
                        dArr(dicName.Item(b(i, 1)), c) = "X"
                    Else
                        dArr(dicName.Item(b(i, 1)), dicCity.Item(b(i, 2))) = "X"
                    End If
            Next
  Sheets("Sheet3").Range("A2").Resize(lr1, c) = dArr
End Sub
 
Upvote 0
phuocam đã viết:
Thử
Mã: 
Sub Test()
  Dim a, b, i, lr1, lr2, c, k
  Dim dicName As Object, dicCity As Object
  Dim dArr
  Set dicName = CreateObject("Scripting.Dictionary")
  Set dicCity = CreateObject("Scripting.Dictionary")
With Sheets("Sheet1")
        lr1 = .Range("A" & Rows.Count).End(xlUp).Row
        a = .Range("A1:A" & lr1).Value
End With
        lr1 = UBound(a, 1)
        ReDim dArr(1 To lr1, 1 To 1)
        k = 1
            For i = 2 To lr1
                    If Not dicName.Exists(a(i, 1)) Then
                        k = k + 1
                        dicName.Add a(i, 1), k
                        dArr(k, 1) = a(i, 1)
                    End If
            Next
With Sheets("Sheet2")
        lr2 = .Range("A" & Rows.Count).End(xlUp).Row
        b = .Range("A2:B" & lr2).Value
End With
c = 1
            For i = 1 To UBound(b, 1)
                    If Not dicCity.Exists(b(i, 2)) Then
                        c = c + 1
                        ReDim Preserve dArr(1 To lr1, 1 To c)
                        dicCity.Add b(i, 2), c
                        dArr(1, c) = b(i, 2)
                        dArr(dicName.Item(b(i, 1)), c) = "X"
                    Else
                        dArr(dicName.Item(b(i, 1)), dicCity.Item(b(i, 2))) = "X"
                    End If
            Next
  Sheets("Sheet3").Range("A2").Resize(lr1, c) = dArr
End Sub
Nhấp chuột vào đây để mở rộng...
Code dài quá anh, dùng ADO sẽ ngắn hơn.
 
Upvote 0
@Chủ thớt: Dữ liệu tại sheet1 đâu đảm bảo tính duy nhất để quản lý đâu??!!
Trùng tên (trùng cả họ và tên) thì sao? Chưa kể trùng tiếp địa chỉ (ở chung giường còn có thì chung quốc gia sá gì?).

Ví dụ: Ở sheet2, Daisy ở nước Anh làm việc ở Hà Nội, Daisy của nước Mỹ làm việc ở Đà Nẵng thì sao?


phuocam đã viết:
Thử
Nhấp chuột vào đây để mở rộng...
Hình như có gì chưa đúng á anh.
Bảng sheet3:
- Cột A được bê từ cột A sheet1 sang.
- Dòng 2 liệt kê nơi làm việc từ cột B sheet2.
- Dò từng phần tử cột A so với cột A trong sheet2, nếu thấy và xét cột B sheet2 thì đánh dấu vị trí tương ứng vào bảng.
Nên không có chỗ dùng dicName để lọc tên đâu anh.
 
Upvote 0
tam888 đã viết:
Ngắn thực ra là do SQL làm hết rồi, Viết theo VBA còn có cái mà tư duy, viết kiểu mì ăn sẵn thì nhanh
Nhấp chuột vào đây để mở rộng...
Với mình thì suy nghĩ khác. Nếu dùng cách nào đó mà cảm thấy nó dễ thì cứ làm. Đâu nhất thiết phải tư duy vào những việc mà mình cho là không đáng phải tư duy.
 
Upvote 0
langtusau9x đã viết:
bác HLMT cho e hỏi. nếu dùng ADO thì code sẽ thế nào ạ. e muốn tham khảo để học hỏi thêm về ADO thôi ạ. mong bác chia sẻ. e cảm ơn bác :D
Nhấp chuột vào đây để mở rộng...
Bạn có thể tham khảo thêm về cách tạo CrossTab Query, bài này có thể dùng CrossTab query đó bạn.
 
Upvote 0
Từ CrossTab có nghĩa là "chuyển dọc thành ngang". Mỗi nhóm (group) trong dòng chuyển thành 1 cột (tab).
CrossTab Query có nghĩa là loại lệnh truy vấn chuyển kết quả của những dòng thành những cột. Theo ngôn ngữ trình bày dữ liệu thì đó là Pivot.
Muốn thực hiện loại lệnh này thì chịu khó học cách thiết kế kết quả ra bảng. Trong giai đoạn đầu, tốt hơn hết là dùng giấy bút thiết kế hoàn chỉnh. Nếu bạn có dưới 1 năm kinh nghiệm về Access thì nên học thẳng trên Access, học qua Excel VBA khó debug lắm.

Chú: ngược lại, nếu chuyển cột thành dòng thì gọi là Unpivot.
 
Upvote 0
Hai Lúa Miền Tây đã viết:
Bạn có thể tham khảo thêm về cách tạo CrossTab Query, bài này có thể dùng CrossTab query đó bạn.
Nhấp chuột vào đây để mở rộng...
chả là e đang lần mò cái ADO nên muốn biết thêm nhiều trường hợp sử dụng các câu lệnh truy vấn, dù sao cũng cảm ơn bác về gợi ý trên ^^^^
Bài đã được tự động gộp:

VetMini đã viết:
Từ CrossTab có nghĩa là "chuyển dọc thành ngang". Mỗi nhóm (group) trong dòng chuyển thành 1 cột (tab).
CrossTab Query có nghĩa là loại lệnh truy vấn chuyển kết quả của những dòng thành những cột. Theo ngôn ngữ trình bày dữ liệu thì đó là Pivot.
Muốn thực hiện loại lệnh này thì chịu khó học cách thiết kế kết quả ra bảng. Trong giai đoạn đầu, tốt hơn hết là dùng giấy bút thiết kế hoàn chỉnh. Nếu bạn có dưới 1 năm kinh nghiệm về Access thì nên học thẳng trên Access, học qua Excel VBA khó debug lắm.

Chú: ngược lại, nếu chuyển cột thành dòng thì gọi là Unpivot.
Nhấp chuột vào đây để mở rộng...
cảm ơn bác về lời khuyên. thú thật là từ bé đến giờ học cũng như làm chủ yếu toàn word với excel bác ạ. cũng tò mò và muốn sử dụng cái access thế nào nhưng hiện tại va vấp nó ít quá nên đâm ra cũng hơi ... ^^^^
 
Lần chỉnh sửa cuối:
Upvote 0
Hai Lúa Miền Tây đã viết:
Với mình thì suy nghĩ khác. Nếu dùng cách nào đó mà cảm thấy nó dễ thì cứ làm. Đâu nhất thiết phải tư duy vào những việc mà mình cho là không đáng phải tư duy.
Nhấp chuột vào đây để mở rộng...
Dùng ADO & SQL áp cho Excel VBA là kiểu ngoại lai
Tư duy là sử thuật toán áp dụng cho ngôn ngữ lập trình (ở đây là VBA)- còn dùng cái sẵn có gọi kiểu là ăn buffet.
Tất nhiên mỗi người thích 1 kiểu có người thích tự chuẩn bị món ăn từ nguyên liệu, có những người muốn có sẵn chỉ cần bày, cắt và gắp là xong. Không ai sai ai đúng ở đây, chỉ là ý kiến cho những người cần tư duy.
 
Upvote 0
tam888 đã viết:
Dùng ADO & SQL áp cho Excel VBA là kiểu ngoại lai
Tư duy là sử thuật toán áp dụng cho ngôn ngữ lập trình (ở đây là VBA)- còn dùng cái sẵn có gọi kiểu là ăn buffet.
Tất nhiên mỗi người thích 1 kiểu có người thích tự chuẩn bị món ăn từ nguyên liệu, có những người muốn có sẵn chỉ cần bày, cắt và gắp là xong. Không ai sai ai đúng ở đây, chỉ là ý kiến cho những người cần tư duy.
Nhấp chuột vào đây để mở rộng...
Chưa hẳn SQL là món mì ăn liền như bạn nói. Theo suy nghĩ của bạn cái ADO là "ngoại lai", vậy thì cái Dictionary là "nội lai", như tôi nói ở trên đâu có nói chỗ nào ai đúng hay ai sai.
 
Upvote 0
Hai Lúa Miền Tây đã viết:
Chưa hẳn SQL là món mì ăn liền như bạn nói. Theo suy nghĩ của bạn cái ADO là "ngoại lai", vậy thì cái Dictionary là "nội lai", như tôi nói ở trên đâu có nói chỗ nào ai đúng hay ai sai.
Nhấp chuột vào đây để mở rộng...
Túm lại ai thích gì thì ăn đó, buffet hay thức ăn sẵn, hay tự nấu từ nguyên liệu ... cứ ăn thì rõ
 
Upvote 0
Đã dùng VBA mà còn nói chuyện lai giống với lộn giòng. Kinh thật.
 
Lần chỉnh sửa cuối:
Upvote 0
phuocam đã viết:
Thử
Mã: 
Sub Test()
  Dim a, b, i, lr1, lr2, c, k
  Dim dicName As Object, dicCity As Object
  Dim dArr
  Set dicName = CreateObject("Scripting.Dictionary")
  Set dicCity = CreateObject("Scripting.Dictionary")
With Sheets("Sheet1")
        lr1 = .Range("A" & Rows.Count).End(xlUp).Row
        a = .Range("A1:A" & lr1).Value
End With
        lr1 = UBound(a, 1)
        ReDim dArr(1 To lr1, 1 To 1)
        k = 1
            For i = 2 To lr1
                    If Not dicName.Exists(a(i, 1)) Then
                        k = k + 1
                        dicName.Add a(i, 1), k
                        dArr(k, 1) = a(i, 1)
                    End If
            Next
With Sheets("Sheet2")
        lr2 = .Range("A" & Rows.Count).End(xlUp).Row
        b = .Range("A2:B" & lr2).Value
End With
c = 1
            For i = 1 To UBound(b, 1)
                    If Not dicCity.Exists(b(i, 2)) Then
                        c = c + 1
                        ReDim Preserve dArr(1 To lr1, 1 To c)
                        dicCity.Add b(i, 2), c
                        dArr(1, c) = b(i, 2)
                        dArr(dicName.Item(b(i, 1)), c) = "X"
                    Else
                        dArr(dicName.Item(b(i, 1)), dicCity.Item(b(i, 2))) = "X"
                    End If
            Next
  Sheets("Sheet3").Range("A2").Resize(lr1, c) = dArr
End Sub
Nhấp chuột vào đây để mở rộng...


Cảm ơn bác phuocam rất nhiều
@ Sheet địa chỉ chỉ để tham khảo thôi ạ, kết quả vẫn là tên và nơi làm việc để match lại ạ
 
Lần chỉnh sửa cuối:
Upvote 0
Hi bác phuocam, nhờ bác xem giúp tin nhắn với ạ
 
Lần chỉnh sửa cuối:
Upvote 0
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

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

V
  • Question
GIúp code xóa các tên mặt hàng trùng nhau, chỉ chừa lại tên cho dòng trên cùng
Trả lời
9
Đọc
239
Phuocam
Phuocam
hoanggiang1811
File excel bị nhảy trang in khi máy dùng màn hình CRT
Trả lời
6
Đọc
4K
pthau72
pthau72
T
Tổng hợp từ Sheet1 qua Sheet2
Trả lời
3
Đọc
48
hoangtuaotrang_hp_vn
H
T
Cần bạn viết phần mềm quản lý quán karaoke bằng excel
Trả lời
5
Đọc
112
VetMini
V
P
Hướng dẫn giải bài tập excel
Trả lời
1
Đọc
42
VetMini
V
Xem thêm…

Facebook

Giaiphapexcel.com

Group

DIỄN ĐÀN GIẢI PHÁP EXCEL Group 1
DIỄN ĐÀN GIẢI PHÁP EXCEL Group 2

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

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

Back
Top Bottom