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

N
Tạo công thức đánh số thứ tự (3 người xem)
Trả lời
2
Đọc
35
HUONGHCKT
H
N
e cần hỗ trợ code vba từ các a chị trên đây ạ. (1 người xem)
Trả lời
2
Đọc
77
bebo021999
B
GPE-Trợ Lý
[GPE] TALK SHOW CÙNG NHẢY LAM BA ĐA VỚI HÀM LAMBDA (λ) EXCEL 365
    • Thích
Trả lời
1
Đọc
66
VetMini
V
X
add-in báo lỗi mỗi khi mở file (1 người xem)
Trả lời
4
Đọc
90
Xike20009x
X
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ố
Trả lời
6
Đọc
149
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
114
bebo021999
B
K
cố định, không thay đổi kích thước, ( fit) độ rộng dòng, cột
Trả lời
5
Đọc
82
HeSanbi
HeSanbi
E
Tính tổng số tiền còn lại theo điều kiện
Trả lời
4
Đọc
51
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
170
tt_kimbai
T
dung1983
Hỏi về import - Table/ XML cho bảng, trang có chứa JS
Trả lời
2
Đọc
111
HeSanbi
HeSanbi
hoangluongvinh
Cách nhặt các dữ liệu bị trùng của 1 đối tượng
Trả lời
12
Đọc
224
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
    • Thích
    • Cảm ơn
Trả lời
1
Đọc
256
HeSanbi
HeSanbi
H
xin mọi người giúp em làm tròn với ạ
Trả lời
5
Đọc
120
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é
Trả lời
3
Đọc
130
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
    • 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
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