Trích lọc kết quả theo điều kiện (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)
T

thinhnx22

Thành viên hoạt động
Tham gia
22/12/15
Bài viết
182
Được thích
38
Gửi anh chị và các bạn,
Công ty mình đến thời điểm hiện tại có 3 trường hợp bán hàng phát sinh:
TH1: bán sản phẩm không chịu thuế
TH2: bán sản phẩm chịu thuế
TH3: bán sản phẩm chịu thuế + hàng khuyến mại kèm theo
Trong sheet KQ mình đã mô tả kết quả cần lấy theo từng tình huống.
Mình code thử một file test để anh chị dễ hình dùng hơn cách mình muốn lấy (vì không phải ai học cùng chuyên ngành)
Nếu file cần thiết kế lại để dễ làm thì anh chị cứ góp ý.
Rất mong được sự giúp đỡ của anh chị.
Chân thành cảm ơn.
 

File đính kèm

Sắp xếp theo thời gian sắp xếp theo bầu chọn
thinhnx22 đã viết:
Gửi anh chị và các bạn,
Công ty mình đến thời điểm hiện tại có 3 trường hợp bán hàng phát sinh:
TH1: bán sản phẩm không chịu thuế
TH2: bán sản phẩm chịu thuế
TH3: bán sản phẩm chịu thuế + hàng khuyến mại kèm theo
Trong sheet KQ mình đã mô tả kết quả cần lấy theo từng tình huống.
Mình code thử một file test để anh chị dễ hình dùng hơn cách mình muốn lấy (vì không phải ai học cùng chuyên ngành)
Nếu file cần thiết kế lại để dễ làm thì anh chị cứ góp ý.
Rất mong được sự giúp đỡ của anh chị.
Chân thành cảm ơn.
Nhấp chuột vào đây để mở rộng...
Mã: 
Sub Laysolieu()
  Dim sArr(), Res(), kMai()
  Dim eRow&, sRow&, sCol&, i&, j&, k&
 
  With Sheets("kq")
    eRow = .Range("B" & Rows.Count).End(xlUp).Row
    If eRow > 21 Then .Range("B22:AA" & eRow).ClearContents
  End With
  With Sheets("chitiet")
    eRow = .Range("A" & Rows.Count).End(xlUp).Row
    If eRow < 22 Then MsgBox ("Khong co du lieu"): Exit Sub
    sArr = .Range("A22:Z" & eRow).Value
    kMai = .Range("A21:X21").Value
  End With
  sRow = UBound(sArr, 1): sCol = UBound(sArr, 2)
  If sRow * 6 < Rows.Count Then
    ReDim Res(1 To sRow * 6, 1 To sCol)
  Else
    ReDim Res(1 To Rows.Count - 22, 1 To sCol)
  End If
  For i = 1 To sRow
    If sArr(i, 1) <> Empty Then
      k = k + 1
      Res(k, 1) = sArr(i, 3)
      Res(k, 2) = sArr(i, 4)
      Res(k, 3) = sArr(i, 2)
      Res(k, 4) = "DT bán hàng" & "-" & sArr(i, 18) & "-" & sArr(i, 6) & "-HD:" & sArr(i, 3) & sArr(i, 1)
      Res(k, 5) = "131"
      Res(k, 7) = sArr(i, 12)
      If sArr(i, 20) = "CT" Then
        Res(k, 6) = "5111"
        Res(k, 16) = "có"
      Else
        Res(k, 6) = "5112"
        Res(k, 16) = "ko"
      End If
      If sArr(i, 14) > 0 Then
        k = k + 1
        Res(k, 1) = sArr(i, 3)
        Res(k, 2) = sArr(i, 4)
        Res(k, 3) = sArr(i, 2)
        Res(k, 4) = "VAT-DT bán hàng" & "-" & sArr(i, 18) & "-" & sArr(i, 6) & "-HD:" & sArr(i, 3) & sArr(i, 1)
        Res(k, 5) = "131"
        Res(k, 6) = "33311"
        Res(k, 7) = sArr(i, 14)
        Res(k, 16) = "có"
      End If
      If sArr(i, 20) = "CT" Then
        For j = 21 To 24
          If sArr(i, j) > 0 Then
            k = k + 1
            Res(k, 1) = sArr(i, 3)
            Res(k, 2) = sArr(i, 4)
            Res(k, 3) = sArr(i, 2)
            Res(k, 4) = "DT bán hàng" & "-" & sArr(i, 18) & "-" & sArr(i, 6) & "-HD:" & sArr(i, 3) & sArr(i, 1)
            Res(k, 5) = "6411"
            If j < 23 Then
              Res(k, 6) = "5111"
            Else
              Res(k, 6) = "33311"
            End If
            Res(k, 7) = sArr(i, j)
            Res(k, 14) = kMai(1, j)
            Res(k, 16) = "có"
          End If
        Next j
      End If
    End If
  Next
  If k Then
    With Sheets("kq")
      .Range("B22").Resize(k, 3).NumberFormat = "@"
      .Range("H22").Resize(k).NumberFormat = "#,##0"
      .Range("B22").Resize(k, sCol).Value = Res
    End With
  End If
End Sub
 

File đính kèm

Upvote 0
HieuCD đã viết:
Mã: 
Sub Laysolieu()
  Dim sArr(), Res(), kMai()
  Dim eRow&, sRow&, sCol&, i&, j&, k&

  With Sheets("kq")
    eRow = .Range("B" & Rows.Count).End(xlUp).Row
    If eRow > 21 Then .Range("B22:AA" & eRow).ClearContents
  End With
  With Sheets("chitiet")
    eRow = .Range("A" & Rows.Count).End(xlUp).Row
    If eRow < 22 Then MsgBox ("Khong co du lieu"): Exit Sub
    sArr = .Range("A22:Z" & eRow).Value
    kMai = .Range("A21:X21").Value
  End With
  sRow = UBound(sArr, 1): sCol = UBound(sArr, 2)
  If sRow * 6 < Rows.Count Then
    ReDim Res(1 To sRow * 6, 1 To sCol)
  Else
    ReDim Res(1 To Rows.Count - 22, 1 To sCol)
  End If
  For i = 1 To sRow
    If sArr(i, 1) <> Empty Then
      k = k + 1
      Res(k, 1) = sArr(i, 3)
      Res(k, 2) = sArr(i, 4)
      Res(k, 3) = sArr(i, 2)
      Res(k, 4) = "DT bán hàng" & "-" & sArr(i, 18) & "-" & sArr(i, 6) & "-HD:" & sArr(i, 3) & sArr(i, 1)
      Res(k, 5) = "131"
      Res(k, 7) = sArr(i, 12)
      If sArr(i, 20) = "CT" Then
        Res(k, 6) = "5111"
        Res(k, 16) = "có"
      Else
        Res(k, 6) = "5112"
        Res(k, 16) = "ko"
      End If
      If sArr(i, 14) > 0 Then
        k = k + 1
        Res(k, 1) = sArr(i, 3)
        Res(k, 2) = sArr(i, 4)
        Res(k, 3) = sArr(i, 2)
        Res(k, 4) = "VAT-DT bán hàng" & "-" & sArr(i, 18) & "-" & sArr(i, 6) & "-HD:" & sArr(i, 3) & sArr(i, 1)
        Res(k, 5) = "131"
        Res(k, 6) = "33311"
        Res(k, 7) = sArr(i, 14)
        Res(k, 16) = "có"
      End If
      If sArr(i, 20) = "CT" Then
        For j = 21 To 24
          If sArr(i, j) > 0 Then
            k = k + 1
            Res(k, 1) = sArr(i, 3)
            Res(k, 2) = sArr(i, 4)
            Res(k, 3) = sArr(i, 2)
            Res(k, 4) = "DT bán hàng" & "-" & sArr(i, 18) & "-" & sArr(i, 6) & "-HD:" & sArr(i, 3) & sArr(i, 1)
            Res(k, 5) = "6411"
            If j < 23 Then
              Res(k, 6) = "5111"
            Else
              Res(k, 6) = "33311"
            End If
            Res(k, 7) = sArr(i, j)
            Res(k, 14) = kMai(1, j)
            Res(k, 16) = "có"
          End If
        Next j
      End If
    End If
  Next
  If k Then
    With Sheets("kq")
      .Range("B22").Resize(k, 3).NumberFormat = "@"
      .Range("H22").Resize(k).NumberFormat = "#,##0"
      .Range("B22").Resize(k, sCol).Value = Res
    End With
  End If
End Sub
Nhấp chuột vào đây để mở rộng...
Chào bác HieuCD, bác xem lại giúp cháu dòng 24 và 25 ở sheet kết quả với ạ. Phần Nợ tk 131 có tk 5111: kết quả phải là: 6.398.182-(317.273+180.909)=5.900.000. Phần nợ tk 131 có tk 33311: 639.818-(31727+18091)=590.000 (như cháu mô tả trong file). Còn tất cả phần còn lại đều đúng rồi ạ. Cháu cảm ơn bác nhiều.
 
Upvote 0
thinhnx22 đã viết:
Chào bác HieuCD, bác xem lại giúp cháu dòng 24 và 25 ở sheet kết quả với ạ. Phần Nợ tk 131 có tk 5111: kết quả phải là: 6.398.182-(317.273+180.909)=5.900.000. Phần nợ tk 131 có tk 33311: 639.818-(31727+18091)=590.000 (như cháu mô tả trong file). Còn tất cả phần còn lại đều đúng rồi ạ. Cháu cảm ơn bác nhiều.
Nhấp chuột vào đây để mở rộng...
Trừ bớt
Mã: 
Sub Laysolieu()
  Dim sArr(), Res(), kMai()
  Dim eRow&, sRow&, sCol&, i&, j&, k&
 
  With Sheets("kq")
    eRow = .Range("B" & Rows.Count).End(xlUp).Row
    If eRow > 21 Then .Range("B22:AA" & eRow).ClearContents
  End With
  With Sheets("chitiet")
    eRow = .Range("A" & Rows.Count).End(xlUp).Row
    If eRow < 22 Then MsgBox ("Khong co du lieu"): Exit Sub
    sArr = .Range("A22:Z" & eRow).Value
    kMai = .Range("A21:X21").Value
  End With
  sRow = UBound(sArr, 1): sCol = UBound(sArr, 2)
  If sRow * 6 < Rows.Count Then
    ReDim Res(1 To sRow * 6, 1 To sCol)
  Else
    ReDim Res(1 To Rows.Count - 22, 1 To sCol)
  End If
  For i = 1 To sRow
    If sArr(i, 1) <> Empty Then
      k = k + 1
      Res(k, 1) = sArr(i, 3)
      Res(k, 2) = sArr(i, 4)
      Res(k, 3) = sArr(i, 2)
      Res(k, 4) = "DT bán hàng" & "-" & sArr(i, 18) & "-" & sArr(i, 6) & "-HD:" & sArr(i, 3) & sArr(i, 1)
      Res(k, 5) = "131"
      Res(k, 7) = sArr(i, 12) - sArr(i, 21) - sArr(i, 22)
      If sArr(i, 20) = "CT" Then
        Res(k, 6) = "5111"
        Res(k, 16) = "có"
      Else
        Res(k, 6) = "5112"
        Res(k, 16) = "ko"
      End If
      If sArr(i, 14) > 0 Then
        k = k + 1
        Res(k, 1) = sArr(i, 3)
        Res(k, 2) = sArr(i, 4)
        Res(k, 3) = sArr(i, 2)
        Res(k, 4) = "VAT-DT bán hàng" & "-" & sArr(i, 18) & "-" & sArr(i, 6) & "-HD:" & sArr(i, 3) & sArr(i, 1)
        Res(k, 5) = "131"
        Res(k, 6) = "33311"
        Res(k, 7) = sArr(i, 14) - sArr(i, 23) - sArr(i, 24)
        Res(k, 16) = "có"
      End If
      If sArr(i, 20) = "CT" Then
        For j = 21 To 24
          If sArr(i, j) > 0 Then
            k = k + 1
            Res(k, 1) = sArr(i, 3)
            Res(k, 2) = sArr(i, 4)
            Res(k, 3) = sArr(i, 2)
            Res(k, 4) = "DT bán hàng" & "-" & sArr(i, 18) & "-" & sArr(i, 6) & "-HD:" & sArr(i, 3) & sArr(i, 1)
            Res(k, 5) = "6411"
            If j < 23 Then
              Res(k, 6) = "5111"
            Else
              Res(k, 6) = "33311"
            End If
            Res(k, 7) = sArr(i, j)
            Res(k, 14) = kMai(1, j)
            Res(k, 16) = "có"
          End If
        Next j
      End If
    End If
  Next
  If k Then
    With Sheets("kq")
      .Range("B22").Resize(k, 3).NumberFormat = "@"
      .Range("H22").Resize(k).NumberFormat = "#,##0"
      .Range("B22").Resize(k, sCol).Value = Res
    End With
  End If
End Sub
 
Upvote 0
HieuCD đã viết:
Trừ bớt
Mã: 
Sub Laysolieu()
  Dim sArr(), Res(), kMai()
  Dim eRow&, sRow&, sCol&, i&, j&, k&

  With Sheets("kq")
    eRow = .Range("B" & Rows.Count).End(xlUp).Row
    If eRow > 21 Then .Range("B22:AA" & eRow).ClearContents
  End With
  With Sheets("chitiet")
    eRow = .Range("A" & Rows.Count).End(xlUp).Row
    If eRow < 22 Then MsgBox ("Khong co du lieu"): Exit Sub
    sArr = .Range("A22:Z" & eRow).Value
    kMai = .Range("A21:X21").Value
  End With
  sRow = UBound(sArr, 1): sCol = UBound(sArr, 2)
  If sRow * 6 < Rows.Count Then
    ReDim Res(1 To sRow * 6, 1 To sCol)
  Else
    ReDim Res(1 To Rows.Count - 22, 1 To sCol)
  End If
  For i = 1 To sRow
    If sArr(i, 1) <> Empty Then
      k = k + 1
      Res(k, 1) = sArr(i, 3)
      Res(k, 2) = sArr(i, 4)
      Res(k, 3) = sArr(i, 2)
      Res(k, 4) = "DT bán hàng" & "-" & sArr(i, 18) & "-" & sArr(i, 6) & "-HD:" & sArr(i, 3) & sArr(i, 1)
      Res(k, 5) = "131"
      Res(k, 7) = sArr(i, 12) - sArr(i, 21) - sArr(i, 22)
      If sArr(i, 20) = "CT" Then
        Res(k, 6) = "5111"
        Res(k, 16) = "có"
      Else
        Res(k, 6) = "5112"
        Res(k, 16) = "ko"
      End If
      If sArr(i, 14) > 0 Then
        k = k + 1
        Res(k, 1) = sArr(i, 3)
        Res(k, 2) = sArr(i, 4)
        Res(k, 3) = sArr(i, 2)
        Res(k, 4) = "VAT-DT bán hàng" & "-" & sArr(i, 18) & "-" & sArr(i, 6) & "-HD:" & sArr(i, 3) & sArr(i, 1)
        Res(k, 5) = "131"
        Res(k, 6) = "33311"
        Res(k, 7) = sArr(i, 14) - sArr(i, 23) - sArr(i, 24)
        Res(k, 16) = "có"
      End If
      If sArr(i, 20) = "CT" Then
        For j = 21 To 24
          If sArr(i, j) > 0 Then
            k = k + 1
            Res(k, 1) = sArr(i, 3)
            Res(k, 2) = sArr(i, 4)
            Res(k, 3) = sArr(i, 2)
            Res(k, 4) = "DT bán hàng" & "-" & sArr(i, 18) & "-" & sArr(i, 6) & "-HD:" & sArr(i, 3) & sArr(i, 1)
            Res(k, 5) = "6411"
            If j < 23 Then
              Res(k, 6) = "5111"
            Else
              Res(k, 6) = "33311"
            End If
            Res(k, 7) = sArr(i, j)
            Res(k, 14) = kMai(1, j)
            Res(k, 16) = "có"
          End If
        Next j
      End If
    End If
  Next
  If k Then
    With Sheets("kq")
      .Range("B22").Resize(k, 3).NumberFormat = "@"
      .Range("H22").Resize(k).NumberFormat = "#,##0"
      .Range("B22").Resize(k, sCol).Value = Res
    End With
  End If
End Sub
Nhấp chuột vào đây để mở rộng...
Cháu cũng vừa tự sửa được rồi ạ. Cảm ơn bác nhiều, chúc bác nhiều sức khỏe.
 
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

GPE-Trợ Lý
[GPE] TALK SHOW CÙNG NHẢY LAM BA ĐA VỚI HÀM LAMBDA (λ) EXCEL 365 (3 người xem)
Trả lời
1
Đọc
45
VetMini
V
X
add-in báo lỗi mỗi khi mở file
Trả lời
4
Đọc
82
Xike20009x
X
N
e cần hỗ trợ code vba từ các a chị trên đây ạ. (1 người xem)
Trả lời
0
Đọc
34
nguyendinhanh10496@gmail.
N
Nguyễn Duy Tuân
Add-In A-Tools - Truy vấn (lọc), soạn thảo và quản trị dữ liệu Excel qua mạng (1 người xem)
    • Thích
32 33 34
Trả lời
670
Đọc
265K
Nguyễn Duy Tuân
Nguyễn Duy Tuân
Nguyễn Duy Tuân
Phiên bản mới Add-in A-Tools v10 (2024) (1 người xem)
    • Thích
2 3
Trả lời
43
Đọc
3K
Nguyễn Duy Tuân
Nguyễn Duy Tuân
NguyenBaChien
Nhờ tách lấy số và tính tổng có điều kiện của dãy số (1 người xem)
Trả lời
6
Đọc
140
bebo021999
B
L
[Xin giúp] Cách copy công thức từ bảng tham chiếu vào một ô (1 người xem)
Trả lời
4
Đọc
106
bebo021999
B
K
cố định, không thay đổi kích thước, ( fit) độ rộng dòng, cột (1 người xem)
Trả lời
5
Đọc
77
HeSanbi
HeSanbi
E
Tính tổng số tiền còn lại theo điều kiện (1 người xem)
Trả lời
4
Đọc
42
Em khong biet
E
T
  • Question Question
Lọc dữ liệu có nhiều điều kiện (1 người xem)
Trả lời
4
Đọc
161
tt_kimbai
T
dung1983
Hỏi về import - Table/ XML cho bảng, trang có chứa JS (1 người xem)
Trả lời
2
Đọc
103
HeSanbi
HeSanbi
hoangluongvinh
Cách nhặt các dữ liệu bị trùng của 1 đối tượng (1 người xem)
Trả lời
12
Đọc
221
vantuongk4
V
HeSanbi
  • Question Question
VBA nâng cao: Nhúng tập tin vào trang tính hoặc trích xuất chúng nhanh chóng (1 người xem)
    • Thích
    • Cảm ơn
Trả lời
1
Đọc
250
HeSanbi
HeSanbi
H
xin mọi người giúp em làm tròn với ạ (1 người xem)
Trả lời
5
Đọc
115
vietduc147258
V
N
  • Question Question
Cách viết tiếng việt có dấu trong msgbox,....... Hoàn toàn mới
    • Thích
2
Trả lời
35
Đọc
5K
ligktit
L
longhungvnpost
cả nhà giúp e tạo ô tìm kiếm gợi ý trong danh sách nhé (2 người xem)
Trả lời
3
Đọc
120
longhungvnpost
longhungvnpost
S
Cố định độ rộng/ cao của cột/hàng?
Trả lời
12
Đọc
17K
khanhnth02
K
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
15 16 17
Trả lời
329
Đọc
26K
tt_kimbai
T
HeSanbi
  • Đã giải quyết
VBA_FastCode v2.22 - Công cụ học và viết mã VBA một cách nhanh nhất (*27/10/2023)
    • Thích
    • Yêu thích
    • Cảm ơn
2 3
Trả lời
51
Đọc
15K
HeSanbi
HeSanbi
Manhhung90
Mail merge in ấn theo từng trang mong muốn. (2 người xem)
Trả lời
1
Đọc
119
Hoàng Tuấn 868
H
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
TALKSHOW KHÁM PHÁ SỨC MẠNH HÀM FILTER TRONG EXCEL 365
Back
Top Bottom