Dò tìm bằng code VBA (5 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)
T

thao nguyen01

Thành viên thường trực
Tham gia
8/12/19
Bài viết
241
Được thích
30
Kính gửi anh/chị,

E đang bị vướng về dò tìm Mã bên sheet Danh muc và điền vào sheet Do tim. Em muốn dùng Hàm Left, lấy 3 ký tự đầu của tk Nợ và tk có của sheet Do tim giống với tài khoản nợ và tài khoản có của sheet Danh muc thì sẽ lấy mã bên sheet Danh muc ạ. Anh/chị xem giúp em ạ. E cảm ơn nhiều ạ.
 

File đính kèm

thao nguyen01 đã viết:
Kính gửi anh/chị,

E đang bị vướng về dò tìm Mã bên sheet Danh muc và điền vào sheet Do tim. Em muốn dùng Hàm Left, lấy 3 ký tự đầu của tk Nợ và tk có của sheet Do tim giống với tài khoản nợ và tài khoản có của sheet Danh muc thì sẽ lấy mã bên sheet Danh muc ạ. Anh/chị xem giúp em ạ. E cảm ơn nhiều ạ.
Nhấp chuột vào đây để mở rộng...
E4 =IFERROR(LOOKUP(2,1/(LEFT(C4,3)='danh muc'!$B$2:$B$4&"")/(LEFT(D4,3)='danh muc'!$C$2:$C$4&""),'danh muc'!$D$2:$D$4),"")
 
HieuCD đã viết:
E4 =IFERROR(LOOKUP(2,1/(LEFT(C4,3)='danh muc'!$B$2:$B$4&"")/(LEFT(D4,3)='danh muc'!$C$2:$C$4&""),'danh muc'!$D$2:$D$4),"")
Nhấp chuột vào đây để mở rộng...

Dạ. Thầy @HieuCD có thể giúp e bài này bằng code VBA ạ. Vì data của e 1 tháng khoảng 8000 dòng. 1 năm có thể 100.000 dòng. Nên e dùng công thức sẽ chạy chậm ạ. Thầy xem giúp em với ạ. E cảm ơn Thầy @HieuCD nhiều lắm ạ.
 
thao nguyen01 đã viết:
Dạ. Thầy @HieuCD có thể giúp e bài này bằng code VBA ạ. Vì data của e 1 tháng khoảng 8000 dòng. 1 năm có thể 100.000 dòng. Nên e dùng công thức sẽ chạy chậm ạ. Thầy xem giúp em với ạ. E cảm ơn Thầy @HieuCD nhiều lắm ạ.
Nhấp chuột vào đây để mở rộng...
Mã: 
Sub DoMa()
  Dim sArr(), DanhMuc(), Res()
  Dim i&, ik&, sRow&
  With Sheets("danh muc")
    i = .Range("B" & Rows.Count).End(xlUp).Row
    If i < 2 Then MsgBox ("Khong co Danh muc"): Exit Sub
    DanhMuc = .Range("B2:D" & i).Value
  End With
  With Sheets("Do tim")
    i = .Range("C" & Rows.Count).End(xlUp).Row
    If i < 4 Then MsgBox ("Khong co Tai khoan"): Exit Sub
    sArr = Range("C4:D" & i).Value
  End With
  With CreateObject("scripting.dictionary")
    sRow = UBound(DanhMuc)
    For i = 1 To sRow
      .Item(DanhMuc(i, 1) & "#" & DanhMuc(i, 2)) = DanhMuc(i, 3)
    Next i
    sRow = UBound(sArr)
    ReDim Res(1 To sRow, 1 To 1)
    For i = 1 To sRow
      Res(i, 1) = .Item(Left(sArr(i, 1), 3) & "#" & Left(sArr(i, 2), 3))
    Next i
  End With
  Sheets("Do tim").Range("E4").Resize(sRow) = Res
End Sub
 
HieuCD đã viết:
Mã: 
Sub DoMa()
  Dim sArr(), DanhMuc(), Res()
  Dim i&, ik&, sRow&
  With Sheets("danh muc")
    i = .Range("B" & Rows.Count).End(xlUp).Row
    If i < 2 Then MsgBox ("Khong co Danh muc"): Exit Sub
    DanhMuc = .Range("B2:D" & i).Value
  End With
  With Sheets("Do tim")
    i = .Range("C" & Rows.Count).End(xlUp).Row
    If i < 4 Then MsgBox ("Khong co Tai khoan"): Exit Sub
    sArr = Range("C4:D" & i).Value
  End With
  With CreateObject("scripting.dictionary")
    sRow = UBound(DanhMuc)
    For i = 1 To sRow
      .Item(DanhMuc(i, 1) & "#" & DanhMuc(i, 2)) = DanhMuc(i, 3)
    Next i
    sRow = UBound(sArr)
    ReDim Res(1 To sRow, 1 To 1)
    For i = 1 To sRow
      Res(i, 1) = .Item(Left(sArr(i, 1), 3) & "#" & Left(sArr(i, 2), 3))
    Next i
  End With
  Sheets("Do tim").Range("E4").Resize(sRow) = Res
End Sub
Nhấp chuột vào đây để mở rộng...

Dạ, e cảm ơn Thầy @HieuCD nhiều ạ.
 
HieuCD đã viết:
Mã: 
Sub DoMa()
  Dim sArr(), DanhMuc(), Res()
  Dim i&, ik&, sRow&
  With Sheets("danh muc")
    i = .Range("B" & Rows.Count).End(xlUp).Row
    If i < 2 Then MsgBox ("Khong co Danh muc"): Exit Sub
    DanhMuc = .Range("B2:D" & i).Value
  End With
  With Sheets("Do tim")
    i = .Range("C" & Rows.Count).End(xlUp).Row
    If i < 4 Then MsgBox ("Khong co Tai khoan"): Exit Sub
    sArr = Range("C4:D" & i).Value
  End With
  With CreateObject("scripting.dictionary")
    sRow = UBound(DanhMuc)
    For i = 1 To sRow
      .Item(DanhMuc(i, 1) & "#" & DanhMuc(i, 2)) = DanhMuc(i, 3)
    Next i
    sRow = UBound(sArr)
    ReDim Res(1 To sRow, 1 To 1)
    For i = 1 To sRow
      Res(i, 1) = .Item(Left(sArr(i, 1), 3) & "#" & Left(sArr(i, 2), 3))
    Next i
  End With
  Sheets("Do tim").Range("E4").Resize(sRow) = Res
End Sub
Nhấp chuột vào đây để mở rộng...

Dạ, e đang bị vướng về dò danh mục có len(tài khoản) không giống nhau ạ. E ví dụ: Đối với tài khoản 5112, độ dài là 4 khác so với các tài khoản còn lại là 3 thì k lấy được ạ. Thầy @HieuCD xem giúp e với ạ. E cảm ơn ạ.
 

File đính kèm

thao nguyen01 đã viết:
Dạ, e đang bị vướng về dò danh mục có len(tài khoản) không giống nhau ạ. E ví dụ: Đối với tài khoản 5112, độ dài là 4 khác so với các tài khoản còn lại là 3 thì k lấy được ạ. Thầy @HieuCD xem giúp e với ạ. E cảm ơn ạ.
Nhấp chuột vào đây để mở rộng...
Ngoài tài khoản cấp 1 và 2, còn có tài khoản cấp 3, 4 ... không
 
HieuCD đã viết:
Ngoài tài khoản cấp 1 và 2, còn có tài khoản cấp 3, 4 ... không
Nhấp chuột vào đây để mở rộng...
Dạ còn ạ. Nhưng vấn đề bài này là e cần lọc và thống kê ra những tài khoản theo danh mục: có cấp 1 và có cấp 2... ạ. Nó không đồng nhất trong cách lấy ạ. Còn trường hợp toàn bộ cấp 2 hay toàn bộ cấp 3,... e lấy được ạ. Nhưng do lấy không đồng nhất thì e đang vướng ạ. Vì có 1 số tài khoản cần theo dõi chi tiết ạ. Thầy @HieuCD xem giúp e ạ. E cảm ơn Thầy ạ.
 
thao nguyen01 đã viết:
Dạ còn ạ. Nhưng vấn đề bài này là e cần lọc và thống kê ra những tài khoản theo danh mục: có cấp 1 và có cấp 2... ạ. Nó không đồng nhất trong cách lấy ạ. Còn trường hợp toàn bộ cấp 2 hay toàn bộ cấp 3,... e lấy được ạ. Nhưng do lấy không đồng nhất thì e đang vướng ạ. Vì có 1 số tài khoản cần theo dõi chi tiết ạ. Thầy @HieuCD xem giúp e ạ. E cảm ơn Thầy ạ.
Nhấp chuột vào đây để mở rộng...
Gởi lại file với sheet danh mục đầy đủ các trường hợp mới có hướng xử lý thích hợp
 
HieuCD đã viết:
Gởi lại file với sheet danh mục đầy đủ các trường hợp mới có hướng xử lý thích hợp
Nhấp chuột vào đây để mở rộng...
dạ, danh mục của e ứng với data này là danh mục đầy đủ luôn ạ. Vì Data này e lấy để lập kết quả kinh doanh nên chỉ 1 số chỉ tiêu ạ. Thầy @HieuCD xem giúp e ạ.
 
HieuCD đã viết:
Sheet danh mục làm gì có tài khoản cấp 2
Nhấp chuột vào đây để mở rộng...
Dạ. Ý e là: đối với loại lấy tất cả theo tk cấp 1 hay cấp 2, cấp 3 thì e sẽ tính theo hàm left ạ. Nhưng e chỉ làm được nếu tất cả theo tk cấp 1 hay cấp 2 hay cấp 3. Còn đối với danh mục này thì e lại k biết làm như thế nào ạ. Thầy @HieuCD xem giúp e ạ. E cảm ơn Thầy.
 
thao nguyen01 đã viết:
Dạ. Ý e là: đối với loại lấy tất cả theo tk cấp 1 hay cấp 2, cấp 3 thì e sẽ tính theo hàm left ạ. Nhưng e chỉ làm được nếu tất cả theo tk cấp 1 hay cấp 2 hay cấp 3. Còn đối với danh mục này thì e lại k biết làm như thế nào ạ. Thầy @HieuCD xem giúp e ạ. E cảm ơn Thầy.
Nhấp chuột vào đây để mở rộng...
Gởi lại file với sheet danh mục là dữ liệu thực tế
 
HieuCD đã viết:
Gởi lại file với sheet danh mục là dữ liệu thực tế
Nhấp chuột vào đây để mở rộng...

Dạ, e gửi lại file ạ. Thầy @HieuCD xem giúp e ạ. E cảm ơn Thầy ạ.
Bài đã được tự động gộp:

HieuCD đã viết:
Gởi lại file với sheet danh mục là dữ liệu thực tế
Nhấp chuột vào đây để mở rộng...
Thầy @HieuCD lấy giúp e file e mới gửi ạ. E mới chỉnh lại ạ. danh mục gồm 23 cặp ạ. Hồi nãy e gửi sẽ bị trùng ạ. Thầy lấy giúp e ạ. E cảm ơn Thầy ạ.
 

File đính kèm

Lần chỉnh sửa cuối:
thanh thao nguyen đã viết:
Dạ, e gửi lại file ạ. Thầy @HieuCD xem giúp e ạ. E cảm ơn Thầy ạ.
Bài đã được tự động gộp:


Thầy @HieuCD lấy giúp e file e mới gửi ạ. E mới chỉnh lại ạ. danh mục gồm 23 cặp ạ. Hồi nãy e gửi sẽ bị trùng ạ. Thầy lấy giúp e ạ. E cảm ơn Thầy ạ.
Nhấp chuột vào đây để mở rộng...
Chạy code
Mã: 
Sub DoMa()
  Dim sArr(), DanhMuc(), Res(), S, S2, iKey$, tmp$
  Dim i&, j&, Dno&, Dco&, sRow&, TKno$, TKco$
  With Sheets("danh muc")
    i = .Range("B" & Rows.Count).End(xlUp).Row
    If i < 2 Then MsgBox ("Khong co Danh muc"): Exit Sub
    DanhMuc = .Range("B2:D" & i).Value
  End With
  With Sheets("data")
    i = .Range("C" & Rows.Count).End(xlUp).Row
    If i < 4 Then MsgBox ("Khong co Tai khoan"): Exit Sub
    sArr = Range("C4:D" & i).Value
  End With
  With CreateObject("scripting.dictionary")
    sRow = UBound(DanhMuc)
    For i = 1 To sRow
      If DanhMuc(i, 1) <> Empty Then
        TKno = DanhMuc(i, 1)
        TKco = DanhMuc(i, 2)
        .Item(TKno & "#" & TKco) = DanhMuc(i, 3)
        iKey = Left(TKno, 3) & "##" & Left(TKco, 3)
        .Item(iKey) = .Item(iKey) & "-" & Len(TKno) & "," & Len(TKco)
      End If
    Next i
    sRow = UBound(sArr)
    ReDim Res(1 To sRow, 1 To 1)
    For i = 1 To sRow
      TKno = sArr(i, 1)
      TKco = sArr(i, 2)
      tmp = .Item(Left(TKno, 3) & "##" & Left(TKco, 3))
      If InStr(1, tmp, "-") > 0 Then
        S = Split(tmp, "-")
        For j = 1 To UBound(S)
          S2 = Split(S(j), ",")
          Dno = S2(0)
          Dco = S2(1)
          iKey = Left(TKno, Dno) & "#" & Left(TKco, Dco)
          If .exists(iKey) Then
            Res(i, 1) = .Item(iKey)
            Exit For
          End If
        Next j
      End If
    Next i
  End With
  Sheets("data").Range("E4").Resize(sRow) = Res
End Sub
 
HieuCD đã viết:
Chạy code
Mã: 
Sub DoMa()
  Dim sArr(), DanhMuc(), Res(), S, S2, iKey$, tmp$
  Dim i&, j&, Dno&, Dco&, sRow&, TKno$, TKco$
  With Sheets("danh muc")
    i = .Range("B" & Rows.Count).End(xlUp).Row
    If i < 2 Then MsgBox ("Khong co Danh muc"): Exit Sub
    DanhMuc = .Range("B2:D" & i).Value
  End With
  With Sheets("data")
    i = .Range("C" & Rows.Count).End(xlUp).Row
    If i < 4 Then MsgBox ("Khong co Tai khoan"): Exit Sub
    sArr = Range("C4:D" & i).Value
  End With
  With CreateObject("scripting.dictionary")
    sRow = UBound(DanhMuc)
    For i = 1 To sRow
      If DanhMuc(i, 1) <> Empty Then
        TKno = DanhMuc(i, 1)
        TKco = DanhMuc(i, 2)
        .Item(TKno & "#" & TKco) = DanhMuc(i, 3)
        iKey = Left(TKno, 3) & "##" & Left(TKco, 3)
        .Item(iKey) = .Item(iKey) & "-" & Len(TKno) & "," & Len(TKco)
      End If
    Next i
    sRow = UBound(sArr)
    ReDim Res(1 To sRow, 1 To 1)
    For i = 1 To sRow
      TKno = sArr(i, 1)
      TKco = sArr(i, 2)
      tmp = .Item(Left(TKno, 3) & "##" & Left(TKco, 3))
      If InStr(1, tmp, "-") > 0 Then
        S = Split(tmp, "-")
        For j = 1 To UBound(S)
          S2 = Split(S(j), ",")
          Dno = S2(0)
          Dco = S2(1)
          iKey = Left(TKno, Dno) & "#" & Left(TKco, Dco)
          If .exists(iKey) Then
            Res(i, 1) = .Item(iKey)
            Exit For
          End If
        Next j
      End If
    Next i
  End With
  Sheets("data").Range("E4").Resize(sRow) = Res
End Sub
Nhấp chuột vào đây để mở rộng...
Dạ, em cảm ơn Thầy @HieuCD nhiều ạ.
 
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

micam111
  • Question Question
Cách chạy nhiều đồng hồ đếm giờ trong VBA (1 người xem)
Trả lời
2
Đọc
595
tranduc36
T
vsitcnh
Hỗ trợ công thức tính điểm dựa theo điều kiện.
Trả lời
13
Đọc
103
Hoàng Tuấn 868
H
1
Hỏi về đánh dấu hàng ngang hàng dọc bằng màu khi kích chuột vào 1 ô
Trả lời
7
Đọc
175
Gà Công Nghệ
Gà Công Nghệ
PhanTuHuong
Sách Lập trình VBA trong AutoCAD đã có mặt (1 người xem)
    • Thích
    • Yêu thích
2
Trả lời
20
Đọc
1K
Mr.hieudoanxd
Mr.hieudoanxd
P
Excell code vba : Tìm Cell để sửa dữ liệu
    • Buồn
2
Trả lời
26
Đọc
523
Phạm Trường 80
P
L
Lỗi font khi convert từ pdf
Trả lời
1
Đọc
56
Hoàng Tuấn 868
H
D
Nhờ anh em giúp đỡ.
    • Buồn
Trả lời
2
Đọc
77
SA_DQ
SA_DQ
00029591
Cần hỗ trợ công thức tổng hợp dữ liệu không cần cột phụ Vlookup (1 người xem)
Trả lời
2
Đọc
75
DeTong
D
H
Đổi số thành chữ trong office 365
Trả lời
19
Đọc
1K
HoangTan891026
H
Gà Công Nghệ
Lấy dữ liệu file excel từ sheet này sang sheet khác
Trả lời
4
Đọc
129
Gà Công Nghệ
Gà Công Nghệ
N
Mong mọi người giúp đỡ
Trả lời
1
Đọc
59
minhminh27
minhminh27
minhduc1o2
Excel lỗi font Time New Roman+
Trả lời
7
Đọc
116
minhduc1o2
minhduc1o2
F
  • Question Question
Tự động Merge Mail bằng VBA
Trả lời
0
Đọc
75
fujishima
F
H
Lọc dữ liệu trong XL
    • Cười
Trả lời
0
Đọc
46
huong.dinh
H
giaiphap
Add-Ins hổ trợ Word trộn danh sách và lưu ra nhiều tệp tin khác nhau.
    • Thích
    • Yêu thích
    • Cảm ơn
2
Trả lời
39
Đọc
9K
fujishima
F
K
xin file excel bảng đấu bóng đá (1 người xem)
    • Yêu thích
2 3
Trả lời
40
Đọc
25K
subin1905
S
B
Xin giải pháp chống sửa, xóa dữ liệu đã nhập vào từ ngày hôm trước.
    • Thích
2
Trả lời
24
Đọc
7K
chihuumvc
C
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
1
Đọc
66
bebo021999
B
G
Hướng dẫn Lập danh sách File
    • Không thích
Trả lời
16
Đọc
269
thanhhuy_hvnh
thanhhuy_hvnh
baolong240793
Nhờ Anh/Chị hỗ trợ em hàm Randbetween() với ạ.
Trả lời
4
Đọc
362
bebo021999
B
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
TALK SHOW: CÙNG NHẢY LAM BA ĐA VỚI HÀM LAMBDA (λ) EXCEL 365
Back
Top Bottom