Thống kê tình hình sử dụng hóa đơn theo điều kiện

quick87 · 28/2/20

Em chào mọi người,

Em có vấn đề liên quan đến việc tổng hợp báo cáo tình hình sử dụng hóa đơn theo Quý theo từng Mẫu số và ký hiệu từ sheet "Chitiet" theo mẫu kết quả được tổng hợp tại sheet: "Thongke" mong được giúp đỡ. Cụ thể:

Dữ liệu được liệt kê tại sheet "Chitiet":

Tổng hợp theo mẫu báo cáo tại Sheet "Thongke":

Từng chỉ tiêu tại sheet "Thongke" được lấy bên sheet "Chitiet" theo điều kiện như sau:

(1) Mẫu số: được lấy từ Cột B
(2) Ký hiệu: được lấy từ Cột C
(3) Số lượng đã sử dụng: là tổng số hóa đơn có trạng thái là: "Đã in" tại cột "Trạng thái hóa đơn" (Cột M)
(4) Số lượng xóa bỏ: là tổng số hóa đơn có trạng thái là: "Đã xóa" tại cột "Trạng thái hóa đơn" (Cột M)
(5) Số: liệt kê chi tiết những hóa đơn có trạng thái là xóa bỏ, được liệt kê theo từng số và cách nhau bằng dấu ";, nếu số liên tục thì được thống kê theo khoảng (-)

Ví dụ, với "Mẫu số" là "01GTKT0/001", có "Ký hiệu hóa đơn" là "AA/19E" có số hóa đơn xóa bỏ như hình dưới là:

=> sẽ cần phải thống kê như sau: 88795-88802;88806-88807;88817-88819;88855-88856;88858;88860;88902-88903;94489;94757;...
và cho đến những số còn lại.

(6) Từ số: số hóa đơn cuối cùng đã sử dụng trong Quý.

Mong được mọi người giúp đỡ ạ. Em cảm ơn thật nhiều.
Chi tiết, em xin phép gửi file đính kèm.

HieuCD · 21/7/20

quick87 đã viết:
Anh @HieuCD ơi, nhờ anh xem thêm giúp em phần "Lấy số tồn cuối kỳ" trong trường hợp như file đính kèm.
Theo trường hợp này, số "Tồn cuối kỳ"đúng phải là số "12288" mới đúng nhưng code hiện tại đang trả về là số "12253":

View attachment 241492

Em đính kèm file chi tiết, nhờ anh và các thành viên xem giúp ạ.
Em cảm ơn !

Theo yêu cầu của bạn

	Thống kê tình hình sử dụng hóa đơn trong Quý theo từng Mẫu số và ký hiệu từ sheet "Chitiet" theo mẫu tại sheet: "Thongke", trong đó:
1	-Mẫu số: được lấy từ Cột B
2	- Ký hiệu: được lấy từ Cột C
3	- Số lượng đã sử dụng: là tổng số hóa đơn có trạng thái là: "Đã in" tại cột "Trạng thái hóa đơn" (Cột N)
4	- Số lượng xóa bỏ: là tổng số hóa đơn có trạng thái là: "Đã xóa" tại cột "Trạng thái hóa đơn" (Cột N)
5	- Số: liệt kê chi tiết những hóa đơn có trạng thái là xóa bỏ, nếu liên tục thì được thống kê theo khoảng (-), các số cách nhau bằng dấu ";"
6	- Từ số: số hóa đơn cuối cùng đã sử dụng trong Quý

Trong file

0012288

30/03/2020

1

-

-2

Đã xóa

0012288 là đã xóa không phải sử dụng

quick87 · 22/7/20

HieuCD đã viết:
Theo yêu cầu của bạn

Thống kê tình hình sử dụng hóa đơn trong Quý theo từng Mẫu số và ký hiệu từ sheet "Chitiet" theo mẫu tại sheet: "Thongke", trong đó:
1
-Mẫu số: được lấy từ Cột B
2
- Ký hiệu: được lấy từ Cột C
3
- Số lượng đã sử dụng: là tổng số hóa đơn có trạng thái là: "Đã in" tại cột "Trạng thái hóa đơn" (Cột N)
4
- Số lượng xóa bỏ: là tổng số hóa đơn có trạng thái là: "Đã xóa" tại cột "Trạng thái hóa đơn" (Cột N)
5
- Số: liệt kê chi tiết những hóa đơn có trạng thái là xóa bỏ, nếu liên tục thì được thống kê theo khoảng (-), các số cách nhau bằng dấu ";"
6
- Từ số: số hóa đơn cuối cùng đã sử dụng trong Quý

Trong file

0012288 30/03/2020
1
- - - - -
-2
Đã xóa

0012288 là đã xóa không phải sử dụng

Dạ, em xin lỗi Anh. Do em diễn đạt chưa hết ý mục số 6.
Mục số 6, tức là em cần lấy ra số hóa đơn cuối cùng đã xuất trong kỳ, không phân biệt "Trạng thái hóa đơn" là "Đã xóa" hay "Đã in".
=> Ví dụ, như dữ liệu em gửi ở bài trên thì số hóa đơn cuối cùng đã xuất trong kỳ là số: 0012288.

leonguyenz đã viết:

Duy thử file sau xem

Mã:

Sub TKeHD()
Dim hD(), rS(), i&, Lr&, k&, Tm$, d$, SoHD&, Dic As Object
With Sheets("Chitiet")
    Lr = .Range("B65535").End(xlUp).Row
    If Lr < 2 Then MsgBox ("Khong co du lieu"): Exit Sub
    hD = .Range("B2:M" & Lr + 1).Value
End With
Sheets("ThongKe").Range("B5:G100").ClearContents
ReDim rS(1 To UBound(hD), 1 To 6)
Set Dic = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(hD) - 1
    Tm = hD(i, 1) & " " & hD(i, 2): SoHD = hD(i, 3)
    If Not Dic.Exists(Tm) Then
        k = k + 1: Dic.Add Tm, k
        rS(k, 1) = hD(i, 1): rS(k, 2) = hD(i, 2)
        If hD(i, 12) Like "*in*" Then
            rS(k, 3) = rS(k, 3) + 1
        Else
            rS(k, 4) = rS(k, 4) + 1
            rS(k, 5) = SoHD
            rS(k, 6) = hD(i, 3)
        End If
    Else
        d = Dic.Item(Tm)
        If hD(i, 12) Like "*in*" Then
            rS(d, 3) = rS(d, 3) + 1
        Else
            rS(d, 4) = rS(d, 4) + 1: rS(d, 6) = hD(i, 3)
            If hD(i - 1, 12) Like "*in*" Then
                rS(d, 5) = rS(d, 5) & ";" & SoHD
            ElseIf hD(i + 1, 12) Like "*in*" Or _
                hD(i, 2) <> hD(i + 1, 2) Then
                rS(d, 5) = rS(d, 5) & "-" & SoHD
            End If
            If Left(rS(d, 5), 1) = ";" Then
                rS(d, 5) = Mid(rS(d, 5), 2, Len(rS(d, 5)))
            End If
        End If
    End If
Next i
If k Then Sheets("ThongKe").Range("B5").Resize(k, 6) = rS
Set Dic = Nothing
End Sub

Em cảm ơn Anh. Code anh giúp đã đúng với dữ liệu em gửi nhưng kiểm tra với dữ liệu khác thì bị sai phần lấy ra số hóa đơn cuối cùng đã xuất trong kỳ như em có trình bày bên trên.

Em gửi thêm file mẫu và bảng so sánh kết quả sau khi chạy code của hai anh:

Nhờ các anh và mọi người giúp thêm ạ. Em cảm ơn mọi người thật nhiều!

saolavay · 22/7/20

quick87 đã viết:
Dạ, em xin lỗi Anh. Do em diễn đạt chưa hết ý mục số 6.
Mục số 6, tức là em cần lấy ra số hóa đơn cuối cùng đã xuất trong kỳ, không phân biệt "Trạng thái hóa đơn" là "Đã xóa" hay "Đã in".
=> Ví dụ, như dữ liệu em gửi ở bài trên thì số hóa đơn cuối cùng đã xuất trong kỳ là số: 0012288.

Em cảm ơn Anh. Code anh giúp đã đúng với dữ liệu em gửi nhưng kiểm tra với dữ liệu khác thì bị sai phần lấy ra số hóa đơn cuối cùng đã xuất trong kỳ như em có trình bày bên trên.

Em gửi thêm file mẫu và bảng so sánh kết quả sau khi chạy code của hai anh:

View attachment 241595

Nhờ các anh và mọi người giúp thêm ạ. Em cảm ơn mọi người thật nhiều!

Nếu bạn yêu cầu vậy mình thấy không hợp lí rồi. Hóa đơn số 12288 đã xóa thì tồn cuối kỳ phải là 12289 mới đúng. Không khéo làm xong theo yêu cầu lại phải nhờ chỉnh tiếp đấy...

quick87 · 22/7/20

saolavay đã viết:
Nếu bạn yêu cầu vậy mình thấy không hợp lí rồi. Hóa đơn số 12288 đã xóa thì tồn cuối kỳ phải là 12289 mới đúng. Không khéo làm xong theo yêu cầu lại phải nhờ chỉnh tiếp đấy...

Cảm ơn bạn!
Như mình có trình bày ở trên, tại cột "Tồn cuối kỳ" mình cần lấy ra số hóa đơn cuối cùng đã xuất ra trong kỳ không phân biệt là số đó là xóa bỏ hay sử dụng => mục đích để mình kiểm tra với các báo cáo khác của mình.
Các yêu cầu của mình vẫn chỉ giữ nguyên như thế, nếu có yêu cầu lại thì mình sẽ lập một topic khác.
Cảm ơn bạn đã quan tâm nhé.

saolavay · 22/7/20

quick87 đã viết:
Cảm ơn bạn!
Như mình có trình bày ở trên, tại cột "Tồn cuối kỳ" mình cần lấy ra số hóa đơn cuối cùng đã xuất ra trong kỳ không phân biệt là số đó là xóa bỏ hay sử dụng => mục đích để mình kiểm tra với các báo cáo khác của mình.
Các yêu cầu của mình vẫn chỉ giữ nguyên như thế, nếu có yêu cầu lại thì mình sẽ lập một topic khác.
Cảm ơn bạn đã quan tâm nhé.

Mình góp ý vì sợ bạn nhầm thôi ak. Chứ mình mù tịt VBA... Mình cũng đang làm báo cáo hóa đơn, biên lai theo mẫu BC26 và BC7 nhưng toàn bộ là công thức... KKK

thuyyeu99 · 22/7/20

quick87 đã viết:
Cảm ơn bạn!
Như mình có trình bày ở trên, tại cột "Tồn cuối kỳ" mình cần lấy ra số hóa đơn cuối cùng đã xuất ra trong kỳ không phân biệt là số đó là xóa bỏ hay sử dụng => mục đích để mình kiểm tra với các báo cáo khác của mình.
Các yêu cầu của mình vẫn chỉ giữ nguyên như thế, nếu có yêu cầu lại thì mình sẽ lập một topic khác.
Cảm ơn bạn đã quan tâm nhé.

thì trong code của anh HieuCD bạn bỏ dòng này

Mã:

TuSo = HD(i, 3)

Sửa lại dòng này

Mã:

Res2(k, 1) = TuSo

thành

Mã:

Res2(k, 1) = HD(i, 3)

quick87 · 22/7/20

thuyyeu99 đã viết:
thì trong code của anh HieuCD bạn bỏ dòng này

Mã:

TuSo = HD(i, 3)

Sửa lại dòng này

Mã:

Res2(k, 1) = TuSo

thành

Mã:

Res2(k, 1) = HD(i, 3)

Em cảm ơn Chị!
Em có sửa lại theo Chị hướng dẫn, code đã lấy đúng được phần số hóa đơn cuối cùng nhưng lại đang bị sai phần liệt kê số xóa bỏ như em có tô màu và kết quả lấy bị thiếu mẫu số 01/VE2/002 như em đang có chọn như trong hình:

Nhờ Chị và mọi người hướng dẫn thêm giúp em nhé.
Em cảm ơn !

thuyyeu99 · 22/7/20

quick87 đã viết:
Em cảm ơn Chị!
Em có sửa lại theo Chị hướng dẫn, code đã lấy đúng được phần số hóa đơn cuối cùng nhưng lại đang bị sai phần liệt kê số xóa bỏ như em có tô màu và kết quả lấy bị thiếu mẫu số 01/VE2/002 như em đang có chọn như trong hình:

View attachment 241600

Nhờ Chị và mọi người hướng dẫn thêm giúp em nhé.
Em cảm ơn !

Sửa Code TKeHD

Mã:

Sub TKeHD()
Dim HD(), rS(), i&, Lr&, k&, Tm$, d$, SoHD&, Dic As Object
With Sheets("Chitiet")
    Lr = .Range("B655350").End(xlUp).Row
    If Lr < 2 Then MsgBox ("Khong co du lieu"): Exit Sub
    HD = .Range("B2:M" & Lr + 1).Value
End With
Sheets("ThongKe").Range("B5:G100").ClearContents
ReDim rS(1 To UBound(HD), 1 To 6)
Set Dic = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(HD) - 1
    Tm = HD(i, 1) & " " & HD(i, 2): SoHD = HD(i, 3)
    If Not Dic.Exists(Tm) Then
        k = k + 1: Dic.Add Tm, k
        rS(k, 1) = HD(i, 1): rS(k, 2) = HD(i, 2)
        If HD(i, 12) Like "*in*" Then
            rS(k, 3) = rS(k, 3) + 1
        Else
            rS(k, 4) = rS(k, 4) + 1
            rS(k, 5) = SoHD
            rS(k, 6) = HD(i, 3)
        End If
    Else
        d = Dic.Item(Tm)
        If HD(i, 12) Like "*in*" Then
            rS(d, 3) = rS(d, 3) + 1
        Else
            rS(d, 4) = rS(d, 4) + 1: rS(d, 6) = HD(i, 3)
            If HD(i - 1, 12) Like "*in*" Then
                rS(d, 5) = rS(d, 5) & ";" & SoHD
            ElseIf HD(i + 1, 12) Like "*in*" Or _
                HD(i, 2) <> HD(i + 1, 2) Then
                rS(d, 5) = rS(d, 5) & "-" & SoHD
            End If
            If Left(rS(d, 5), 1) = ";" Then
                rS(d, 5) = Mid(rS(d, 5), 2, Len(rS(d, 5)))
            End If
        End If
        rS(d, 6) = HD(i, 3)
    End If
Next i
If k Then Sheets("ThongKe").Range("B5").Resize(k, 6) = rS
Set Dic = Nothing
End Sub

HieuCD · 22/7/20

quick87 đã viết:
Em cảm ơn Chị!
Em có sửa lại theo Chị hướng dẫn, code đã lấy đúng được phần số hóa đơn cuối cùng nhưng lại đang bị sai phần liệt kê số xóa bỏ như em có tô màu và kết quả lấy bị thiếu mẫu số 01/VE2/002 như em đang có chọn như trong hình:

View attachment 241600

Nhờ Chị và mọi người hướng dẫn thêm giúp em nhé.
Em cảm ơn !

Chỉnh lại

Mã:

Sub HoaDon()
  Dim HD(), TT(), Res(), Res2() As String
  Dim i&, k&, sRow&, SoHD&, tmp&

  With Sheets("Chitiet")
    i = .Range("B" & Rows.Count).End(xlUp).Row
    If i < 2 Then MsgBox ("Khong co du lieu"): Exit Sub
    HD = .Range("B1:D" & i + 1).Value
    TT = .Range("M1:M" & i + 1).Value
  End With
  sRow = UBound(HD)
  ReDim Res(1 To 100, 1 To 6)
  ReDim Res2(1 To 100, 1 To 1)
  For i = 2 To sRow - 1
    If HD(i, 1) & HD(i, 2) <> HD(i - 1, 1) & HD(i - 1, 2) Then
      k = k + 1
      Res(k, 1) = HD(i, 1)
      Res(k, 2) = HD(i, 2)
    End If
    If TT(i, 1) Like "?? in" Then
      Res(k, 3) = Res(k, 3) + 1
    Else
      Res(k, 4) = Res(k, 4) + 1
      If Not (TT(i - 1, 1) Like "?? x?a") Then
        SoHD = HD(i, 3)
        Res(k, 5) = Res(k, 5) & ";" & SoHD
      End If
      If Not (TT(i + 1, 1) Like "?? x?a") Or HD(i, 2) <> HD(i + 1, 2) Then
        If HD(i, 3) > SoHD Then
          Res(k, 5) = Res(k, 5) & "-" & Val(HD(i, 3))
        End If
      End If
    End If
    If HD(i, 1) & HD(i, 2) <> HD(i + 1, 1) & HD(i + 1, 2) Then
      If Len(Res(k, 5)) Then
        Res(k, 5) = Mid(Res(k, 5), 2, Len(Res(k, 5)))
      End If
      Res2(k, 1) = HD(i, 3)
    End If
  Next i
  With Sheets("ThongKe")
    i = .Range("B" & Rows.Count).End(xlUp).Row
    If i > 4 Then .Range("B5:G" & i).ClearContents
    .Range("B5").Resize(k, 5) = Res
    .Range("G5").Resize(k) = Res2
  End With
End Sub

quick87 · 22/7/20

HieuCD đã viết:

Chỉnh lại

Mã:

Sub HoaDon()
  Dim HD(), TT(), Res(), Res2() As String
  Dim i&, k&, sRow&, SoHD&, tmp&

  With Sheets("Chitiet")
    i = .Range("B" & Rows.Count).End(xlUp).Row
    If i < 2 Then MsgBox ("Khong co du lieu"): Exit Sub
    HD = .Range("B1:D" & i + 1).Value
    TT = .Range("M1:M" & i + 1).Value
  End With
  sRow = UBound(HD)
  ReDim Res(1 To 100, 1 To 6)
  ReDim Res2(1 To 100, 1 To 1)
  For i = 2 To sRow - 1
    If HD(i, 1) & HD(i, 2) <> HD(i - 1, 1) & HD(i - 1, 2) Then
      k = k + 1
      Res(k, 1) = HD(i, 1)
      Res(k, 2) = HD(i, 2)
    End If
    If TT(i, 1) Like "?? in" Then
      Res(k, 3) = Res(k, 3) + 1
    Else
      Res(k, 4) = Res(k, 4) + 1
      If Not (TT(i - 1, 1) Like "?? x?a") Then
        SoHD = HD(i, 3)
        Res(k, 5) = Res(k, 5) & ";" & SoHD
      End If
      If Not (TT(i + 1, 1) Like "?? x?a") Or HD(i, 2) <> HD(i + 1, 2) Then
        If HD(i, 3) > SoHD Then
          Res(k, 5) = Res(k, 5) & "-" & Val(HD(i, 3))
        End If
      End If
    End If
    If HD(i, 1) & HD(i, 2) <> HD(i + 1, 1) & HD(i + 1, 2) Then
      If Len(Res(k, 5)) Then
        Res(k, 5) = Mid(Res(k, 5), 2, Len(Res(k, 5)))
      End If
      Res2(k, 1) = HD(i, 3)
    End If
  Next i
  With Sheets("ThongKe")
    i = .Range("B" & Rows.Count).End(xlUp).Row
    If i > 4 Then .Range("B5:G" & i).ClearContents
    .Range("B5").Resize(k, 5) = Res
    .Range("G5").Resize(k) = Res2
  End With
End Sub

Em cảm ơn anh Hiếu thật nhiều ạ!
Em kiểm tra kết quả thấy có phần liệt kê số xóa bỏ của ký hiệu "0303332060_AB/20E" đang bị sai như trong hình:

Nhờ anh xem thêm giúp nhé. Em cảm ơn anh!

Bài đã được tự động gộp: 22/7/20

thuyyeu99 đã viết:

Sửa Code TKeHD

Mã:

Sub TKeHD()
Dim HD(), rS(), i&, Lr&, k&, Tm$, d$, SoHD&, Dic As Object
With Sheets("Chitiet")
    Lr = .Range("B655350").End(xlUp).Row
    If Lr < 2 Then MsgBox ("Khong co du lieu"): Exit Sub
    HD = .Range("B2:M" & Lr + 1).Value
End With
Sheets("ThongKe").Range("B5:G100").ClearContents
ReDim rS(1 To UBound(HD), 1 To 6)
Set Dic = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(HD) - 1
    Tm = HD(i, 1) & " " & HD(i, 2): SoHD = HD(i, 3)
    If Not Dic.Exists(Tm) Then
        k = k + 1: Dic.Add Tm, k
        rS(k, 1) = HD(i, 1): rS(k, 2) = HD(i, 2)
        If HD(i, 12) Like "*in*" Then
            rS(k, 3) = rS(k, 3) + 1
        Else
            rS(k, 4) = rS(k, 4) + 1
            rS(k, 5) = SoHD
            rS(k, 6) = HD(i, 3)
        End If
    Else
        d = Dic.Item(Tm)
        If HD(i, 12) Like "*in*" Then
            rS(d, 3) = rS(d, 3) + 1
        Else
            rS(d, 4) = rS(d, 4) + 1: rS(d, 6) = HD(i, 3)
            If HD(i - 1, 12) Like "*in*" Then
                rS(d, 5) = rS(d, 5) & ";" & SoHD
            ElseIf HD(i + 1, 12) Like "*in*" Or _
                HD(i, 2) <> HD(i + 1, 2) Then
                rS(d, 5) = rS(d, 5) & "-" & SoHD
            End If
            If Left(rS(d, 5), 1) = ";" Then
                rS(d, 5) = Mid(rS(d, 5), 2, Len(rS(d, 5)))
            End If
        End If
        rS(d, 6) = HD(i, 3)
    End If
Next i
If k Then Sheets("ThongKe").Range("B5").Resize(k, 6) = rS
Set Dic = Nothing
End Sub

Em cảm ơn Chị nhiều!
Code của Chị ra kết quả đúng rồi ạ:

thuyyeu99 · 22/7/20

quick87 đã viết:
Em cảm ơn anh Hiếu thật nhiều ạ!
Em kiểm tra kết quả thấy có phần liệt kê số xóa bỏ của ký hiệu "0303332060_AB/20E" đang bị sai như trong hình:

View attachment 241606

bạn sửa lại cái điều kiện của anh hieuCD

Mã:

If Not (TT(i - 1, 1) Like "?? x*") Or HD(i, 2) & HD(i, 1) <> HD(i - 1, 2) & HD(i - 1, 1) Then
.....
If Not ((TT(i + 1, 1) Like "?? x*")) Or HD(i, 2) & HD(i, 1) <> HD(i + 1, 2) & HD(i + 1, 1) Then

quick87 · 22/7/20

thuyyeu99 đã viết:
bạn sửa lại cái điều kiện của anh hieuCD

Mã:

If Not (TT(i - 1, 1) Like "?? x*") Or HD(i, 2) & HD(i, 1) <> HD(i - 1, 2) & HD(i - 1, 1) Then ..... If Not ((TT(i + 1, 1) Like "?? x*")) Or HD(i, 2) & HD(i, 1) <> HD(i + 1, 2) & HD(i + 1, 1) Then

Em thử làm như Chị hướng dẫn mà vẫn bị lỗi Chị ạ:

Chi tiết debug:

Nhờ Chị và mọi người xem thêm giúp em nhé.

thuyyeu99 · 22/7/20

quick87 đã viết:
Em thử làm như Chị hướng dẫn mà vẫn bị lỗi Chị ạ:
View attachment 241619

Chi tiết debug:

View attachment 241618

Nhờ Chị và mọi người xem thêm giúp em nhé.

Mã:

Sub HoaDon()
  Dim HD(), TT(), Res(), Res2() As String
  Dim i&, k&, sRow&, SoHD&, tmp&
  Dim TuSo$
  With Sheets("Chitiet")
    i = .Range("B" & Rows.Count).End(xlUp).Row
    If i < 2 Then MsgBox ("Khong co du lieu"): Exit Sub
    HD = .Range("B1:D" & i + 1).Value
    TT = .Range("M1:M" & i + 1).Value
  End With
  sRow = UBound(HD)
  ReDim Res(1 To 100, 1 To 6)
  ReDim Res2(1 To 100, 1 To 1)
  For i = 2 To sRow - 1
 
    If HD(i, 2) & HD(i, 1) <> HD(i - 1, 2) & HD(i - 1, 1) Then
      k = k + 1
      Res(k, 1) = HD(i, 1)
      Res(k, 2) = HD(i, 2)
      TuSo = ""
    End If
    If TT(i, 1) Like "?? in" Then
      Res(k, 3) = Res(k, 3) + 1
      'TuSo = HD(i, 3)
    Else
      Res(k, 4) = Res(k, 4) + 1
      '////////////////////////////////////
      If Not (TT(i - 1, 1) Like "?? x*") Or HD(i, 2) & HD(i, 1) <> HD(i - 1, 2) & HD(i - 1, 1) Then
        SoHD = HD(i, 3)
        Res(k, 5) = Res(k, 5) & ";" & SoHD
      End If
      If Not ((TT(i + 1, 1) Like "?? x*")) Or HD(i, 2) & HD(i, 1) <> HD(i + 1, 2) & HD(i + 1, 1) Then
        If HD(i, 3) > SoHD Then
          Res(k, 5) = Res(k, 5) & "-" & Val(HD(i, 3))
        End If
      End If
      '///////////////////////////////////
    End If
    If HD(i, 2) & HD(i, 1) <> HD(i + 1, 2) & HD(i + 1, 1) Then '
      If Len(Res(k, 5)) Then
        Res(k, 5) = Mid(Res(k, 5), 2, Len(Res(k, 5)))
      End If
      Res2(k, 1) = HD(i, 3)
    End If
  Next i
  With Sheets("ThongKe")
    i = .Range("B" & Rows.Count).End(xlUp).Row
    If i > 4 Then .Range("B5:G" & i).ClearContents
    .Range("B5").Resize(k, 5) = Res
    .Range("G5").Resize(k) = Res2
  End With
End Sub

hoahuongduong1986 · 22/7/20

Code

HieuCD đã viết:

Chạy code

Mã:

Sub HoaDon()
  Dim HD(), TT(), Res(), Res2() As String
  Dim i&, k&, sRow&, SoHD&, tmp&
  Dim TuSo$
  With Sheets("Chitiet")
    i = .Range("B" & Rows.Count).End(xlUp).Row
    If i < 2 Then MsgBox ("Khong co du lieu"): Exit Sub
    HD = .Range("B1:D" & i + 1).Value
    TT = .Range("M1:M" & i + 1).Value
  End With
  sRow = UBound(HD)
  ReDim Res(1 To 100, 1 To 6)
  ReDim Res2(1 To 100, 1 To 1)
  For i = 2 To sRow - 1
    If HD(i, 2) <> HD(i - 1, 2) Then
      k = k + 1
      Res(k, 1) = HD(i, 1)
      Res(k, 2) = HD(i, 2)
      TuSo = ""
    End If
    If TT(i, 1) Like "?? in" Then
      Res(k, 3) = Res(k, 3) + 1
      TuSo = HD(i, 3)
    Else
      Res(k, 4) = Res(k, 4) + 1
      If Not (TT(i - 1, 1) Like "?? x?a") Then
        SoHD = HD(i, 3)
        Res(k, 5) = Res(k, 5) & ";" & SoHD
      End If
      If Not (TT(i + 1, 1) Like "?? x?a") Or HD(i, 2) <> HD(i + 1, 2) Then
        If HD(i, 3) > SoHD Then
          Res(k, 5) = Res(k, 5) & "-" & Val(HD(i, 3))
        End If
      End If
    End If
    If HD(i, 2) <> HD(i + 1, 2) Then
      If Len(Res(k, 5)) Then
        Res(k, 5) = Mid(Res(k, 5), 2, Len(Res(k, 5)))
      End If
      Res2(k, 1) = TuSo
    End If
  Next i
  With Sheets("ThongKe")
    i = .Range("B" & Rows.Count).End(xlUp).Row
    If i > 4 Then .Range("B5:G" & i).ClearContents
    .Range("B5").Resize(k, 5) = Res
    .Range("G5").Resize(k) = Res2
  End With
End Sub

Code hay quá ạ. Em cũng đang cần cái này! Cảm ơn ạ.

Bài đã được tự động gộp: 22/7/20

Code

HieuCD đã viết:

Chạy code

Mã:

Sub HoaDon()
  Dim HD(), TT(), Res(), Res2() As String
  Dim i&, k&, sRow&, SoHD&, tmp&
  Dim TuSo$
  With Sheets("Chitiet")
    i = .Range("B" & Rows.Count).End(xlUp).Row
    If i < 2 Then MsgBox ("Khong co du lieu"): Exit Sub
    HD = .Range("B1:D" & i + 1).Value
    TT = .Range("M1:M" & i + 1).Value
  End With
  sRow = UBound(HD)
  ReDim Res(1 To 100, 1 To 6)
  ReDim Res2(1 To 100, 1 To 1)
  For i = 2 To sRow - 1
    If HD(i, 2) <> HD(i - 1, 2) Then
      k = k + 1
      Res(k, 1) = HD(i, 1)
      Res(k, 2) = HD(i, 2)
      TuSo = ""
    End If
    If TT(i, 1) Like "?? in" Then
      Res(k, 3) = Res(k, 3) + 1
      TuSo = HD(i, 3)
    Else
      Res(k, 4) = Res(k, 4) + 1
      If Not (TT(i - 1, 1) Like "?? x?a") Then
        SoHD = HD(i, 3)
        Res(k, 5) = Res(k, 5) & ";" & SoHD
      End If
      If Not (TT(i + 1, 1) Like "?? x?a") Or HD(i, 2) <> HD(i + 1, 2) Then
        If HD(i, 3) > SoHD Then
          Res(k, 5) = Res(k, 5) & "-" & Val(HD(i, 3))
        End If
      End If
    End If
    If HD(i, 2) <> HD(i + 1, 2) Then
      If Len(Res(k, 5)) Then
        Res(k, 5) = Mid(Res(k, 5), 2, Len(Res(k, 5)))
      End If
      Res2(k, 1) = TuSo
    End If
  Next i
  With Sheets("ThongKe")
    i = .Range("B" & Rows.Count).End(xlUp).Row
    If i > 4 Then .Range("B5:G" & i).ClearContents
    .Range("B5").Resize(k, 5) = Res
    .Range("G5").Resize(k) = Res2
  End With
End Sub

Code hay quá ạ. Em cũng đang cần cái này! Cảm ơn ạ.

Nhattanktnn · 22/7/20

Cho em chen ngang một xíu xíu rất là nhỏ thôi ạ, em hay thấy code mấy anh chị khai báo biến có tên "Res", vậy nó là viết tắt của từ gì trong tiếng anh vậy ạ?

leonguyenz · 22/7/20

Nhattanktnn đã viết:
Cho em chen ngang một xíu xíu rất là nhỏ thôi ạ, em hay thấy code mấy anh chị khai báo biến có tên "Res", vậy nó là viết tắt của từ gì trong tiếng anh vậy ạ?

Tôi đoán Res là viết tắt của Result trong Tiếng Anh (dịch nghĩa là Kết quả).
Tương tự với nhiều khai báo biến:
sArr = source_array
dArr = data_array, hoặc destination_array (tùy thói quen mỗi người).
rArr = result_array
...

Nhattanktnn · 22/7/20

leonguyenz đã viết:
sArr = source_array
dArr = data_array, hoặc destination_array (tùy thói quen mỗi người).
rArr = result_array

Mấy cái này em cũng đoán đoán được vì nhìn vào code dễ đoán, thấy khai báo mảng nguồn và mảng đích nên cũng đoán là source và destination, còn res hơi khó hình dung nên em không đoán được, còn tmp cũng hay gặp chắc là "temp" anh nhỉ
Cảm ơn anh @leonguyenz

HieuCD · 22/7/20

quick87 đã viết:
Em cảm ơn anh Hiếu thật nhiều ạ!
Em kiểm tra kết quả thấy có phần liệt kê số xóa bỏ của ký hiệu "0303332060_AB/20E" đang bị sai như trong hình:

View attachment 241606

Nhờ anh xem thêm giúp nhé. Em cảm ơn anh!

Bài đã được tự động gộp: 22/7/20

Em cảm ơn Chị nhiều!
Code của Chị ra kết quả đúng rồi ạ:

View attachment 241607

Chỉnh lại

Mã:

Sub HoaDon()
  Dim HD(), TT(), Res(), Res2() As String
  Dim i&, k&, sRow&, SoHD&, tmp&

  With Sheets("Chitiet")
    i = .Range("B" & Rows.Count).End(xlUp).Row
    If i < 2 Then MsgBox ("Khong co du lieu"): Exit Sub
    HD = .Range("B1:D" & i + 1).Value
    TT = .Range("M1:M" & i + 1).Value
  End With
  sRow = UBound(HD)
  ReDim Res(1 To 100, 1 To 6)
  ReDim Res2(1 To 100, 1 To 1)
  For i = 2 To sRow - 1
    If HD(i, 1) & HD(i, 2) <> HD(i - 1, 1) & HD(i - 1, 2) Then
      k = k + 1
      Res(k, 1) = HD(i, 1)
      Res(k, 2) = HD(i, 2)
    End If
    If (TT(i, 1) Like "?? x?a") Then
      If HD(i, 1) & HD(i, 2) & TT(i, 1) <> HD(i - 1, 1) & HD(i - 1, 2) & TT(i - 1, 1) Then
        SoHD = HD(i, 3)
        Res(k, 5) = Res(k, 5) & ";" & SoHD
      ElseIf HD(i, 1) & HD(i, 2) & TT(i, 1) <> HD(i + 1, 1) & HD(i + 1, 2) & TT(i + 1, 1) Then
        If HD(i, 3) > SoHD Then
          Res(k, 5) = Res(k, 5) & "-" & Val(HD(i, 3))
        End If
      End If
    End If
    If TT(i, 1) Like "?? in" Then
      Res(k, 3) = Res(k, 3) + 1
    Else
      Res(k, 4) = Res(k, 4) + 1
    End If
    If HD(i, 1) & HD(i, 2) <> HD(i + 1, 1) & HD(i + 1, 2) Then
      If Len(Res(k, 5)) Then
        Res(k, 5) = Mid(Res(k, 5), 2, Len(Res(k, 5)))
      End If
      Res2(k, 1) = HD(i, 3)
    End If
  Next i
  With Sheets("ThongKe")
    i = .Range("B" & Rows.Count).End(xlUp).Row
    If i > 4 Then .Range("B5:G" & i).ClearContents
    .Range("B5").Resize(k, 5) = Res
    .Range("G5").Resize(k) = Res2
  End With
End Sub

quick87 · 22/7/20

HieuCD đã viết:

Chỉnh lại

Mã:

Sub HoaDon()
  Dim HD(), TT(), Res(), Res2() As String
  Dim i&, k&, sRow&, SoHD&, tmp&

  With Sheets("Chitiet")
    i = .Range("B" & Rows.Count).End(xlUp).Row
    If i < 2 Then MsgBox ("Khong co du lieu"): Exit Sub
    HD = .Range("B1:D" & i + 1).Value
    TT = .Range("M1:M" & i + 1).Value
  End With
  sRow = UBound(HD)
  ReDim Res(1 To 100, 1 To 6)
  ReDim Res2(1 To 100, 1 To 1)
  For i = 2 To sRow - 1
    If HD(i, 1) & HD(i, 2) <> HD(i - 1, 1) & HD(i - 1, 2) Then
      k = k + 1
      Res(k, 1) = HD(i, 1)
      Res(k, 2) = HD(i, 2)
    End If
    If (TT(i, 1) Like "?? x?a") Then
      If HD(i, 1) & HD(i, 2) & TT(i, 1) <> HD(i - 1, 1) & HD(i - 1, 2) & TT(i - 1, 1) Then
        SoHD = HD(i, 3)
        Res(k, 5) = Res(k, 5) & ";" & SoHD
      ElseIf HD(i, 1) & HD(i, 2) & TT(i, 1) <> HD(i + 1, 1) & HD(i + 1, 2) & TT(i + 1, 1) Then
        If HD(i, 3) > SoHD Then
          Res(k, 5) = Res(k, 5) & "-" & Val(HD(i, 3))
        End If
      End If
    End If
    If TT(i, 1) Like "?? in" Then
      Res(k, 3) = Res(k, 3) + 1
    Else
      Res(k, 4) = Res(k, 4) + 1
    End If
    If HD(i, 1) & HD(i, 2) <> HD(i + 1, 1) & HD(i + 1, 2) Then
      If Len(Res(k, 5)) Then
        Res(k, 5) = Mid(Res(k, 5), 2, Len(Res(k, 5)))
      End If
      Res2(k, 1) = HD(i, 3)
    End If
  Next i
  With Sheets("ThongKe")
    i = .Range("B" & Rows.Count).End(xlUp).Row
    If i > 4 Then .Range("B5:G" & i).ClearContents
    .Range("B5").Resize(k, 5) = Res
    .Range("G5").Resize(k) = Res2
  End With
End Sub

thuyyeu99 đã viết:

Mã:

Sub HoaDon()
  Dim HD(), TT(), Res(), Res2() As String
  Dim i&, k&, sRow&, SoHD&, tmp&
  Dim TuSo$
  With Sheets("Chitiet")
    i = .Range("B" & Rows.Count).End(xlUp).Row
    If i < 2 Then MsgBox ("Khong co du lieu"): Exit Sub
    HD = .Range("B1:D" & i + 1).Value
    TT = .Range("M1:M" & i + 1).Value
  End With
  sRow = UBound(HD)
  ReDim Res(1 To 100, 1 To 6)
  ReDim Res2(1 To 100, 1 To 1)
  For i = 2 To sRow - 1

    If HD(i, 2) & HD(i, 1) <> HD(i - 1, 2) & HD(i - 1, 1) Then
      k = k + 1
      Res(k, 1) = HD(i, 1)
      Res(k, 2) = HD(i, 2)
      TuSo = ""
    End If
    If TT(i, 1) Like "?? in" Then
      Res(k, 3) = Res(k, 3) + 1
      'TuSo = HD(i, 3)
    Else
      Res(k, 4) = Res(k, 4) + 1
      '////////////////////////////////////
      If Not (TT(i - 1, 1) Like "?? x*") Or HD(i, 2) & HD(i, 1) <> HD(i - 1, 2) & HD(i - 1, 1) Then
        SoHD = HD(i, 3)
        Res(k, 5) = Res(k, 5) & ";" & SoHD
      End If
      If Not ((TT(i + 1, 1) Like "?? x*")) Or HD(i, 2) & HD(i, 1) <> HD(i + 1, 2) & HD(i + 1, 1) Then
        If HD(i, 3) > SoHD Then
          Res(k, 5) = Res(k, 5) & "-" & Val(HD(i, 3))
        End If
      End If
      '///////////////////////////////////
    End If
    If HD(i, 2) & HD(i, 1) <> HD(i + 1, 2) & HD(i + 1, 1) Then '
      If Len(Res(k, 5)) Then
        Res(k, 5) = Mid(Res(k, 5), 2, Len(Res(k, 5)))
      End If
      Res2(k, 1) = HD(i, 3)
    End If
  Next i
  With Sheets("ThongKe")
    i = .Range("B" & Rows.Count).End(xlUp).Row
    If i > 4 Then .Range("B5:G" & i).ClearContents
    .Range("B5").Resize(k, 5) = Res
    .Range("G5").Resize(k) = Res2
  End With
End Sub

Em cảm ơn anh Hiếu và Chị Thủy. Code của anh chị đã chạy đúng rồi ạ!
Chúc mọi người buổi chiều vui vẻ!

HieuCD · 22/7/20

quick87 đã viết:
Em cảm ơn anh Hiếu và Chị Thủy. Code của anh chị đã chạy đúng rồi ạ!
Chúc mọi người buổi chiều vui vẻ!

Bỏ lệnh If dư

Mã:

Sub HoaDon()
  Dim HD(), TT(), Res(), Res2() As String
  Dim i&, k&, sRow&, tmp&

  With Sheets("Chitiet")
    i = .Range("B" & Rows.Count).End(xlUp).Row
    If i < 2 Then MsgBox ("Khong co du lieu"): Exit Sub
    HD = .Range("B1:D" & i + 1).Value
    TT = .Range("M1:M" & i + 1).Value
  End With
  sRow = UBound(HD)
  ReDim Res(1 To 100, 1 To 6)
  ReDim Res2(1 To 100, 1 To 1)
  For i = 2 To sRow - 1
    If HD(i, 1) & HD(i, 2) <> HD(i - 1, 1) & HD(i - 1, 2) Then
      k = k + 1
      Res(k, 1) = HD(i, 1)
      Res(k, 2) = HD(i, 2)
    End If
    If (TT(i, 1) Like "?? x?a") Then
      If HD(i, 1) & HD(i, 2) & TT(i, 1) <> HD(i - 1, 1) & HD(i - 1, 2) & TT(i - 1, 1) Then
        Res(k, 5) = Res(k, 5) & ";" & Val(HD(i, 3))
      ElseIf HD(i, 1) & HD(i, 2) & TT(i, 1) <> HD(i + 1, 1) & HD(i + 1, 2) & TT(i + 1, 1) Then
        Res(k, 5) = Res(k, 5) & "-" & Val(HD(i, 3))
      End If
    End If
    If TT(i, 1) Like "?? in" Then
      Res(k, 3) = Res(k, 3) + 1
    Else
      Res(k, 4) = Res(k, 4) + 1
    End If
    If HD(i, 1) & HD(i, 2) <> HD(i + 1, 1) & HD(i + 1, 2) Then
      If Len(Res(k, 5)) Then
        Res(k, 5) = Mid(Res(k, 5), 2, Len(Res(k, 5)))
      End If
      Res2(k, 1) = HD(i, 3)
    End If
  Next i
  With Sheets("ThongKe")
    i = .Range("B" & Rows.Count).End(xlUp).Row
    If i > 4 Then .Range("B5:G" & i).ClearContents
    .Range("B5").Resize(k, 5) = Res
    .Range("G5").Resize(k) = Res2
  End With
End Sub

Thống kê tình hình sử dụng hóa đơn theo điều kiện

(/ội...

File đính kèm

Chuyên gia GPE

(/ội...

File đính kèm

Thành viên mới

(/ội...

Thành viên mới

Trùm Nhiều Chuyện

(/ội...

File đính kèm

Trùm Nhiều Chuyện

Chuyên gia GPE

(/ội...

Trùm Nhiều Chuyện

(/ội...

File đính kèm

Trùm Nhiều Chuyện

Thành viên thường trực

Thành viên gắn bó

Thành viên gạo cội

Thành viên gắn bó

Chuyên gia GPE

(/ội...

Chuyên gia GPE

Facebook

Group