Tham chiếu bảng dữ liệu trả về mảng kết quả (1 người xem)

Liên hệ QC

Người dùng đang xem chủ đề này

Đang trực tuyến: 1 (Thành viên: 0, Khách: 1)
PHUNGUYENHAO đã viết:
Em có mô tả diễn giải trong file kính nhờ các a/c code giúp em giảm bớt thao tác thủ công trong công việc, em cảm ơn nhiều !!!
Nhấp chuột vào đây để mở rộng...
Có thể là bạn đang chờ code VBA.
Tôi nhìn dữ liệu của bạn là tôi muốn sử dụng Power Query ngay rồi.
Bạn tham khảo cách làm bằng Power Query theo file đính kèm.
Code VBA chờ các thành viên khác hỗ trợ nhé!
Chúc bạn cuối tuần vui vẻ.
P/s: Yêu cầu 1 bạn sai ở chỗ CAO THỊ F vì vẫn có giá trị E10.5 nằm trong bảng tham chiếu.
 

File đính kèm

vanthinh3101 đã viết:
Có thể là bạn đang chờ code VBA.
Tôi nhìn dữ liệu của bạn là tôi muốn sử dụng Power Query ngay rồi.
Bạn tham khảo cách làm bằng Power Query theo file đính kèm.
Code VBA chờ các thành viên khác hỗ trợ nhé!
Chúc bạn cuối tuần vui vẻ.
P/s: Yêu cầu 1 bạn sai ở chỗ CAO THỊ F vì vẫn có giá trị E10.5 nằm trong bảng tham chiếu.
Nhấp chuột vào đây để mở rộng...
Mình thấy ở yêu cầu 2 thì kết quả mong muốn và kết quả từ Power Query không khớp nhau.
 
Hoàng Tuấn 868 đã viết:
Mình thấy ở yêu cầu 2 thì kết quả mong muốn và kết quả từ Power Query không khớp nhau.
Nhấp chuột vào đây để mở rộng...
Tôi vừa xem lại, đúng là không giống ở cột Ten_nhom.
Tuy nhiên, khi xem kỹ lại yêu cầu thì cột Ten_nhom đang có vấn đề:
- A01, A02, A04 đang được sắp xếp tăng dần
- A03 không có quy tắc sắp xếp
Untitled.png
Nếu đúng theo yêu cầu ban đầu thì tôi không biết giải quyết như thế nào.

Trường hợp tất cả Ten_nhom sắp xếp theo quy tắc tăng dần thì thực hiện theo file đính kèm.
Tôi đã thêm 1 bước là sắp xếp tăng dần cột Ten_nhom trong MergeResult.
Bạn xem nhé!
 

File đính kèm

vanthinh3101 đã viết:
Có thể là bạn đang chờ code VBA.
Tôi nhìn dữ liệu của bạn là tôi muốn sử dụng Power Query ngay rồi.
Bạn tham khảo cách làm bằng Power Query theo file đính kèm.
Code VBA chờ các thành viên khác hỗ trợ nhé!
Chúc bạn cuối tuần vui vẻ.
P/s: Yêu cầu 1 bạn sai ở chỗ CAO THỊ F vì vẫn có giá trị E10.5 nằm trong bảng tham chiếu.
Nhấp chuột vào đây để mở rộng...
alo, bạn xem dùm mình lỗi chố task 2 này dùm bạn Error: 5 arguments were passed to function which expects between 2 and 4. Mình sử dung offcie 2016
 
Lần chỉnh sửa cuối:
vanthinh3101 đã viết:
Có thể là bạn đang chờ code VBA.
Tôi nhìn dữ liệu của bạn là tôi muốn sử dụng Power Query ngay rồi.
Bạn tham khảo cách làm bằng Power Query theo file đính kèm.
Code VBA chờ các thành viên khác hỗ trợ nhé!
Chúc bạn cuối tuần vui vẻ.
P/s: Yêu cầu 1 bạn sai ở chỗ CAO THỊ F vì vẫn có giá trị E10.5 nằm trong bảng tham chiếu.
Nhấp chuột vào đây để mở rộng...
alo, bạn xem dùm mình lỗi chố task 2 này dùm bạn Error: 5 arguments were passed to function which expects between 2 and 4. Mình sử dung offcie 2016
 
PHUNGUYENHAO đã viết:
alo, bạn xem dùm mình lỗi chố task 2 này dùm bạn Error: 5 arguments were passed to function which expects between 2 and 4. Mình sử dung offcie 2016
Nhấp chuột vào đây để mở rộng...
Đăng cùng nội dung nhiều lần thế bạn. Người giúp có phải lúc nào cũng ở đây đợi bạn đâu, Chịu khó mà chờ chứ.
 
Lần chỉnh sửa cuối:
Bạn đổi tên các sheet có dấu thành không dấu nhé.
Mình đổi tên thành task1 và task2
Tại thêm 2 sheet trống ketqua1 và ketqua2 để lưu kết quả
PHP: 
Option Explicit
Sub task1()
Dim lr1&, lr2&, i&, j&, k&, rng, arr(1 To 100000, 1 To 6)
Dim ghichu As Range, s, c As Boolean, gc As String
With Sheets("Task1")
    lr1 = .Cells(Rows.Count, "A").End(xlUp).Row
    rng = .Range("A3:E" & lr1).Value
    lr2 = .Cells(Rows.Count, "H").End(xlUp).Row
    Set ghichu = .Range("H3:H" & lr2)
End With
For i = 1 To UBound(rng)
    c = False: gc = "": s = Split(";" & rng(i, 5), ";")
    For j = 1 To UBound(s)
        If WorksheetFunction.CountIf(ghichu, s(j)) Then
            c = True
            gc = IIf(gc = "", s(j), gc & ";" & s(j))
        End If
    Next
    If c Then
        k = k + 1: arr(k, 6) = gc
        For j = 1 To 5
            arr(k, j) = rng(i, j)
        Next
    End If
Next
With Sheets("ketqua1")
    .Range("A2:E2").Value = Sheets("Task1").Range("A2:E2").Value
    .Range("A3:F100000").ClearContents
    If k > 0 Then .Range("A3").Resize(k, 6).Value = arr
End With
End Sub

PHP: 
Sub task2()
Dim lr1&, lr2&, i&, j&, c&, k&, t&, m&, rng, arr(1 To 100000, 1 To 8)
Dim tc As Range, cell As Range
With Sheets("Task2")
    lr1 = .Cells(Rows.Count, "A").End(xlUp).Row
    rng = .Range("A3:F" & lr1).Value
    lr2 = .Cells(Rows.Count, "I").End(xlUp).Row
    Set tc = .Range("I3:I" & lr2)
End With
For i = 1 To UBound(rng)
    c = WorksheetFunction.CountIf(tc, rng(i, 6))
    If c > 0 Then
        k = k + 1: t = 0
        For j = 1 To 6
            arr(k, j) = rng(i, j)
        Next
        For Each cell In tc
            If cell.Value = rng(i, 6) Then
                k = k + 1: t = t + 1: m = m + 1
                arr(k, 1) = m: arr(k, 2) = rng(i, 1): arr(k, 3) = rng(i, 3)
                arr(k, 4) = rng(i, 4): arr(k, 5) = rng(i, 5): arr(k, 6) = rng(i, 6)
                arr(k, 7) = cell.Offset(, 1).Value: arr(k, 8) = cell.Offset(, 2).Value
            End If
        Next
    End If
Next
With Sheets("ketqua2")
    .Range("A2:F2").Value = Sheets("Task1").Range("A2:F2").Value
    .Range("G2:H2").Value = Array("Ten_nhom", "vi_tri")
    .Range("A3:H100000").NumberFormat = "@"
    .Range("A3:H100000").ClearContents
    If k > 0 Then .Range("A3").Resize(k, 8).Value = arr
End With
End Sub
 

File đính kèm

SA_DQ đã viết:
Gởi chuyển biếu cho mình đôi cũ của bạn nha; chi phí vận chuyển người nhân chịu, khỏi lăn tăn
Đ/c nơi nhận dép cũ: Số 01 Lê Duẫn!
Nhấp chuột vào đây để mở rộng...
Giỡn mặt cha nội. Xúi dại người ta gởi đồ bậy bạ, đi tù ai chịu?

Mà thôi kéo màn rồi. Dép mới dép cũ gì để đem qua thớt khác.
 
bebo021999 đã viết:
Bạn đổi tên các sheet có dấu thành không dấu nhé.
Mình đổi tên thành task1 và task2
Tại thêm 2 sheet trống ketqua1 và ketqua2 để lưu kết quả
PHP: 
Option Explicit
Sub task1()
Dim lr1&, lr2&, i&, j&, k&, rng, arr(1 To 100000, 1 To 6)
Dim ghichu As Range, s, c As Boolean, gc As String
With Sheets("Task1")
    lr1 = .Cells(Rows.Count, "A").End(xlUp).Row
    rng = .Range("A3:E" & lr1).Value
    lr2 = .Cells(Rows.Count, "H").End(xlUp).Row
    Set ghichu = .Range("H3:H" & lr2)
End With
For i = 1 To UBound(rng)
    c = False: gc = "": s = Split(";" & rng(i, 5), ";")
    For j = 1 To UBound(s)
        If WorksheetFunction.CountIf(ghichu, s(j)) Then
            c = True
            gc = IIf(gc = "", s(j), gc & ";" & s(j))
        End If
    Next
    If c Then
        k = k + 1: arr(k, 6) = gc
        For j = 1 To 5
            arr(k, j) = rng(i, j)
        Next
    End If
Next
With Sheets("ketqua1")
    .Range("A2:E2").Value = Sheets("Task1").Range("A2:E2").Value
    .Range("A3:F100000").ClearContents
    If k > 0 Then .Range("A3").Resize(k, 6).Value = arr
End With
End Sub

PHP: 
Sub task2()
Dim lr1&, lr2&, i&, j&, c&, k&, t&, m&, rng, arr(1 To 100000, 1 To 8)
Dim tc As Range, cell As Range
With Sheets("Task2")
    lr1 = .Cells(Rows.Count, "A").End(xlUp).Row
    rng = .Range("A3:F" & lr1).Value
    lr2 = .Cells(Rows.Count, "I").End(xlUp).Row
    Set tc = .Range("I3:I" & lr2)
End With
For i = 1 To UBound(rng)
    c = WorksheetFunction.CountIf(tc, rng(i, 6))
    If c > 0 Then
        k = k + 1: t = 0
        For j = 1 To 6
            arr(k, j) = rng(i, j)
        Next
        For Each cell In tc
            If cell.Value = rng(i, 6) Then
                k = k + 1: t = t + 1: m = m + 1
                arr(k, 1) = m: arr(k, 2) = rng(i, 1): arr(k, 3) = rng(i, 3)
                arr(k, 4) = rng(i, 4): arr(k, 5) = rng(i, 5): arr(k, 6) = rng(i, 6)
                arr(k, 7) = cell.Offset(, 1).Value: arr(k, 8) = cell.Offset(, 2).Value
            End If
        Next
    End If
Next
With Sheets("ketqua2")
    .Range("A2:F2").Value = Sheets("Task1").Range("A2:F2").Value
    .Range("G2:H2").Value = Array("Ten_nhom", "vi_tri")
    .Range("A3:H100000").NumberFormat = "@"
    .Range("A3:H100000").ClearContents
    If k > 0 Then .Range("A3").Resize(k, 8).Value = arr
End With
End Sub
Nhấp chuột vào đây để mở rộng...
Cảm ơn. Code chạy ok ah
 
bebo021999 đã viết:
Bạn đổi tên các sheet có dấu thành không dấu nhé.
Mình đổi tên thành task1 và task2
Tại thêm 2 sheet trống ketqua1 và ketqua2 để lưu kết quả
PHP: 
Option Explicit
Sub task1()
Dim lr1&, lr2&, i&, j&, k&, rng, arr(1 To 100000, 1 To 6)
Dim ghichu As Range, s, c As Boolean, gc As String
With Sheets("Task1")
    lr1 = .Cells(Rows.Count, "A").End(xlUp).Row
    rng = .Range("A3:E" & lr1).Value
    lr2 = .Cells(Rows.Count, "H").End(xlUp).Row
    Set ghichu = .Range("H3:H" & lr2)
End With
For i = 1 To UBound(rng)
    c = False: gc = "": s = Split(";" & rng(i, 5), ";")
    For j = 1 To UBound(s)
        If WorksheetFunction.CountIf(ghichu, s(j)) Then
            c = True
            gc = IIf(gc = "", s(j), gc & ";" & s(j))
        End If
    Next
    If c Then
        k = k + 1: arr(k, 6) = gc
        For j = 1 To 5
            arr(k, j) = rng(i, j)
        Next
    End If
Next
With Sheets("ketqua1")
    .Range("A2:E2").Value = Sheets("Task1").Range("A2:E2").Value
    .Range("A3:F100000").ClearContents
    If k > 0 Then .Range("A3").Resize(k, 6).Value = arr
End With
End Sub

PHP: 
Sub task2()
Dim lr1&, lr2&, i&, j&, c&, k&, t&, m&, rng, arr(1 To 100000, 1 To 8)
Dim tc As Range, cell As Range
With Sheets("Task2")
    lr1 = .Cells(Rows.Count, "A").End(xlUp).Row
    rng = .Range("A3:F" & lr1).Value
    lr2 = .Cells(Rows.Count, "I").End(xlUp).Row
    Set tc = .Range("I3:I" & lr2)
End With
For i = 1 To UBound(rng)
    c = WorksheetFunction.CountIf(tc, rng(i, 6))
    If c > 0 Then
        k = k + 1: t = 0
        For j = 1 To 6
            arr(k, j) = rng(i, j)
        Next
        For Each cell In tc
            If cell.Value = rng(i, 6) Then
                k = k + 1: t = t + 1: m = m + 1
                arr(k, 1) = m: arr(k, 2) = rng(i, 1): arr(k, 3) = rng(i, 3)
                arr(k, 4) = rng(i, 4): arr(k, 5) = rng(i, 5): arr(k, 6) = rng(i, 6)
                arr(k, 7) = cell.Offset(, 1).Value: arr(k, 8) = cell.Offset(, 2).Value
            End If
        Next
    End If
Next
With Sheets("ketqua2")
    .Range("A2:F2").Value = Sheets("Task1").Range("A2:F2").Value
    .Range("G2:H2").Value = Array("Ten_nhom", "vi_tri")
    .Range("A3:H100000").NumberFormat = "@"
    .Range("A3:H100000").ClearContents
    If k > 0 Then .Range("A3").Resize(k, 8).Value = arr
End With
End Sub
Nhấp chuột vào đây để mở rộng...
Bạn ơi, code chạy rất ok, cảm ơn bạn, tuy nhiên ở yêu cầu task1 bạn có thể hiệu chỉnh thêm dùm mình kết quả rán xuống vùng dữ liệu chỉ lấy những dòng có kết quả trả về, bỏ qua những dòng không trả về kết quả dc tô đỏ như trong hình đính kèm đc k ah, như jay jup tốc độ load dữ liệu xuống vùng kết quả nhanh hơn.
 

File đính kèm

  • rán dữ liệu xuong vung (task1) bỏ qua nhưng dòng tô đỏ không có kết quả tra về.PNG
    rán dữ liệu xuong vung (task1) bỏ qua nhưng dòng tô đỏ không có kết quả tra về.PNG
    391.3 KB · Đọc: 9
Bạn up lại file mới này đi. File cũ không có trường hợp này.
 
Thêm 1 chút vào code nhé bạn:
PHP: 
' Them 1 dieu kien: s(j) <>""
If WorksheetFunction.CountIf(ghichu, s(j)) And s(j) <> "" Then
'-----------------------------
 
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

G
Làm sao để sắp xếp nhiều cột và hàng theo abc vậy ạ ? (3 người xem)
Trả lời
5
Đọc
37
gfhngjn
G
K
Lỗi chèn ảnh hàng loạt trong excel 2024 (3 người xem)
Trả lời
1
Đọc
31
ptm0412
ptm0412
GPE-Trợ Lý
[GPE] HỘI THẢO POWER QUERY – CÔNG CỤ QUẢN LÝ DỮ LIỆU HCM (1 người xem)
    • Thích
Trả lời
2
Đọc
1K
ptm0412
ptm0412
K
  • Question Question
nhờ ace giúp đỡ tự động filter và In hàng loạt từng mục trong piviot table
Trả lời
10
Đọc
311
VetMini
V
H
Chuyển file *xml hóa đơn điện tử sang excel
    • Thích
Trả lời
8
Đọc
279
VetMini
V
P
Phát âm thanh tiếng việt cho dữ liệu trong file excel (1 người xem)
Trả lời
2
Đọc
49
ongke0711
ongke0711
N
xin các cao thủ chỉ cách gỡ lỗi không khởi động được excel (1 người xem)
Trả lời
1
Đọc
58
BuiQuangThuan
B
queluatb
  • Question Question
Lấy hóa đơn đầu vào cho hóa đơn đầu ra (1 người xem)
Trả lời
0
Đọc
62
queluatb
queluatb
P
Xin tư vấn về cách tạo bảng quản lý vải
    • Cười
Trả lời
16
Đọc
298
pycckuu410
pycckuu410
ongke0711
  • Question Question
Tải hóa đơn điện tử (https://hoadondientu.gdt.gov.vn/) Excel Vba (1 người xem)
    • Thích
    • Yêu thích
    • Cảm ơn
16 17 18
Trả lời
349
Đọc
31K
tuanktt3
T
D
Nhờ các bác giúp đỡ vấn đề tìm kiếm dữ liệu
Trả lời
6
Đọc
182
Hoàng Tuấn 868
H
P
Hỏi về cách dò tìm từ dưới lên trên, dò tìm trong 2 bảng
Trả lời
7
Đọc
209
kenytien
K
D
Nhờ giúp đỡ về công thức xếp loại rèn luyện theo thông tư 22/2021/TT-BGDĐT
Trả lời
8
Đọc
156
thanthanhan
T
Maika8008
Tặng file quản lý vật tư - công nợ (nhập xuất kho hàng và công nợ khách hàng)
    • Thích
    • Yêu thích
    • Cảm ơn
4 5 6
Trả lời
116
Đọc
25K
Thanh Tam 07
T
D
  • Đã giải quyết
Quản lý email outlook qua VBA cần giúp đỡ
2
Trả lời
25
Đọc
940
befaint
befaint
A
Lấy trường dữ liệu trong file hóa đơn dạng *.xml (1 người xem)
Trả lời
1
Đọc
154
ongke0711
ongke0711
K
Lọc một mã sản phẩm có nhiều đơn giá thành một file riêng
Trả lời
2
Đọc
140
ketoansb123
K
D
Nhờ trợ giúp xác định thứ tự của các từ và cụm từ trong 1 chuỗi văn bản.
Trả lời
10
Đọc
290
Phuocam
Phuocam
1
Vướng mắc về hàm lấy tên đăng nhập máy tính ạ
Trả lời
19
Đọc
606
thuytrangbp28
T
Trungvt3
Công thức trả về định dạng không như mong muốn và viết phân số trong 1 ô.
Trả lời
6
Đọc
209
Trungvt3
Trungvt3
Xem thêm…

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

Đếm ngược thời gian

000
Ngày
00
Giờ
00
phút
00
giây
[GPE] HỘI THẢO POWER QUERY – CÔNG CỤ QUẢN LÝ DỮ LIỆU HCM
Back
Top Bottom