Code lọc theo 4 điều kiện., gom 2 cột thành 1 cột & tách 1 cột thành 2 cột theo ĐK

[Hong.Van]

Em chào Thầy cô & anh chị!
Viết code giúp em để lọc theo 4 điều kiện, trong đó gom 2 cột thành 1 cột & tách 1 cột thành 2 cột theo ĐK như sau:
I/ Em muốn lọc từ Sheet TH sang Sheet Loc theo 4 điều kiện
(ĐK 1) Từ ngày (Cell D6)
(ĐK 2) Đến ngày (Cell D6)
(ĐK 3) Mã Tài Khoản (Cell H6)
(ĐK 4) Mã Khách hàng (cell H7)

Trong đó có 3 điều kiện bắt buộc phải có là điều kiện ĐK 1, ĐK 2, ĐK 3. Còn điều kiện ĐK 4 có thì lọc, không có thì bỏ qua

II/ Trong File em có làm 3 ví dụ về các điều kiện lọc, Bây giờ em lấy Sheet "Lọc - Ví dụ Lọc 4 ĐK" để giải thích:
1/ Ở Sheet Lọc
a/ Dòng 12 (Số dư đầu kỳ) là cthức , để em viết
b/ Sheet Loc sẽ lấy các cột AB, AC, AD, AF, AH của Sheet TH sang
c/ Cột F (Tài khỏan) của Sheet Loc sẽ lấy từ cột AI và AJ và sẽ lấy những số tài khỏan khác với số tài khoản tại cell H6
d/ Cột G, cột H (Nợ-Có) của Sheet Lọc sẽ lấy cột AK của Sheet TH như sau
+ Nếu tài khoản cell H6 có ở cột AI thì số tiền sẽ ở cột G
+ Ngược lại, Nếu tài khoản cell H6 có ở cột AJ thì số tiền sẽ ở cột H
e/ Dòng "Cộng phát sinh" sẽ tổng cộng các dòng trên (trừ dòng số dư đầu kỳ)
f/ Dòng "Số dư cuối kỳ" sẽ lấy theo nguyên tắc cthức như sau:
+ Cell G31

=MAX(($G$12+G30-$H$12-H30);0)

+ Cell H31

=MAX(($H$12+H30-$G$12-G30);0)

Vì bài này em không viết được, nên em nhờ Thầy cô & anh chị giúp đỡ. Em cảm ơn!

 

[Hong.Van]

Khi nào không thêm được dòng Max vào thì thử thế này
k = k + 1
Res(k, 7) = "=sum(R13C:R[-1]C)"
Res(k, 8) = "=sum(R13C:R[-1]C)"
Res(k + 1, 7) = "=Max(R12C+R[-1]C-R12C[1]-R[-1]C[1],0)"
Res(k + 1, 8) = "=Max(R12C+R[-1]C-R12C[-1]-R[-1]C[-1],0)"

[A13].Resize(k + 1, 8) = Res

Em cảm ơn anh, anh giúp em chỉ lại 1 tý là khi không có phát sinh thì dòng cộng phát sinh, cộng luôn chính nó -> bị tham chiếu vòng. Như vậy ta có thể để thêm 1 dòng trống fía trên dòng " Cộng phát sinh" để kg bị lỗi như trên!
--------
P/s: em đã test thử, code anh chạy chính xác với số liệu lớn!

 

[Quang_Hải]

Em cảm ơn anh, anh giúp em chỉ lại 1 tý là khi không có phát sinh thì dòng cộng phát sinh, cộng luôn chính nó -> bị tham chiếu vòng. Như vậy ta có thể để thêm 1 dòng trống fía trên dòng " Cộng phát sinh" để kg bị lỗi như trên!
--------
P/s: em đã test thử, code anh chạy chính xác với số liệu lớn!

Viết liều mạng vậy mà hên trúng.

Thử vầy xem coi được không: k=k+2

 

[Hong.Van]

Không cần phải vậy. Các IF's trong bài này lồng trơn vào nhau - tức là không có lệnh khác. Như vậy ta có thể dùng AND. Phần code trong ELSE cũng in hệt như IF, nên có thể dùng OR

   If Data(i, 1) >= [D5].Value AND Data(i, 1) <= [D6].Value _ ' trong giới hạn ngày '
         AND ([H7].Value = "" OR Data(i, 6) = [H7].Value) _ ' đúng mã KH '
            AND (Data(i, 9) = [H6].Value Or Data(i, 8) = [H6].Value) Then ' dúng mã tài khoản đối chiếu '
               k = k + 1
               Res(k, 1) = Data(i, 1)
               Res(k, 2) = Data(i, 2)
               Res(k, 3) = Data(i, 3)
               Res(k, 4) = Data(i, 5)
               Res(k, 5) = Data(i, 7)
               ' If Data(i, 8) = [H6].Value Then Res(k, 6) = Data(i, 9) '
               ' If Data(i, 9) = [H6].Value Then Res(k, 6) = Data(i, 8) '
               ' If Data(i, 8) = [H6].Value Then Res(k, 7) = Data(i, 10) '
               ' If Data(i, 9) = [H6].Value Then Res(k, 8) = Data(i, 10) '
               ' điều kiện đã thử rồi, [H6].Value bắt buộc phải = Data(i, 8 hoặc 9) '
               Res(k, 6) = Data(i, Iif(Data(i, 8) = [H6].Value, 9, 8))
               Res(k, Iif(Data(i, 8) = [H6].Value, 7, 8)) = Data(i, 10)
   End If

Code trên của bạn mình đã sửa như thế này

Sub loc_VetMini()    Dim Data(), Res(), i, j, k
    [A13:H5000].ClearContents
    Data = Sheet1.Range(Sheet1.[AB9], Sheet1.[AB65536].End(3)).Resize(, 10).Value
    ReDim Res(1 To UBound(Data), 1 To 8)
    For i = 1 To UBound(Data)
        If Data(i, 1) >= [D5].Value And Data(i, 1) <= [D6].Value _
           And ([H7].Value = "" Or Data(i, 6) = [H7].Value) _
           And (Data(i, 9) = [H6].Value Or Data(i, 8) = [H6].Value) Then
            k = k + 1
            Res(k, 1) = Data(i, 1)
            Res(k, 2) = Data(i, 2)
            Res(k, 3) = Data(i, 3)
            Res(k, 4) = Data(i, 5)
            Res(k, 5) = Data(i, 7)
            Res(k, 6) = Data(i, IIf(Data(i, 8) = [H6].Value, 9, 8))
            Res(k, IIf(Data(i, 8) = [H6].Value, 7, 8)) = Data(i, 10)
        End If
        If Data(i, 6) = [H7].Value Then
            If Data(i, 9) = [H6].Value Or Data(i, 8) = [H6].Value Then
                k = k + 1
                Res(k, 1) = Data(i, 1)
                Res(k, 2) = Data(i, 2)
                Res(k, 3) = Data(i, 3)
                Res(k, 4) = Data(i, 5)
                Res(k, 5) = Data(i, 7)
                If Data(i, 8) = [H6].Value Then Res(k, 6) = Data(i, 9)
                If Data(i, 9) = [H6].Value Then Res(k, 6) = Data(i, 8)
                If Data(i, 8) = [H6].Value Then Res(k, 7) = Data(i, 10)
                If Data(i, 9) = [H6].Value Then Res(k, 8) = Data(i, 10)
            End If
        End If
    Next
    k = k + 2
    Res(k, 7) = "=sum(R13C:R[-1]C)"
    Res(k, 8) = "=sum(R13C:R[-1]C)"
    Res(k + 1, 7) = "=Max(R12C+R[-1]C-R12C[1]-R[-1]C[1],0)"
    Res(k + 1, 8) = "=Max(R12C+R[-1]C-R12C[-1]-R[-1]C[-1],0)"
    Res(k, 5) = "C" & ChrW(7897) & "ng phát sinh"    't
    Res(k + 1, 5) = "S" & ChrW(7889) & " d" & ChrW(432) & " cu" & ChrW(7889) & "i k" & ChrW(7923)




    [A13].Resize(k + 1, 8) = Res
End Sub

Tôi kg biết sửa như trên có đúng kg? Nếu đúng thì Code trên bị chạy sai!
Giả sử trong File tôi chọn là tháng 01, Mã tài khoản là 331, mã khách hàng là M020
Mời các Thầy cô và anh chị Test, trong File có code của anh Quanghai & bạn VetMini
Em cảm ơn!

 

[Hoàng Trọng Nghĩa]

Đúng rồi đó anh!!!!!!!!!!!!!

Lu bu với công việc, giờ mới làm tiếp phần dang dỡ buổi trưa đây. Tôi gửi file lên, nếu có gì chưa được thì ta lại làm tiếp hen!

Vì không là dân kế toán nên chẳng biết ất giáp gì cả.

Trong file tôi đã làm như sau:

1) Lọc theo các yêu cầu của bạn

2) Thêm bớt hàng dựa theo dữ liệu

3) Tổng cộng 2 cột Nợ và Có.

Nhưng xin lưu ý cho:

- Tôi có dùng 2 name để xác định khoảng cách giữa 2 hàng, vì thế xin đừng xóa các name này.

- Vì nhằm giữ định dạng nên tôi sẽ luôn chừa 2 hàng trống giữa 2 name, xin đừng bao giờ xóa 2 hàng này nhé!

- Không cần Insert hay Delete hàng giữa 2 name, bởi nó tự động xóa hay thêm hàng.

Và đây là thủ tục dài dòng của tôi, nhưng nó bẫy lỗi cho nhiều trường hợp và cũng có thể tốc độ sẽ cao đấy!

[GPECODE=vb]
Sub LocTongHop()
Dim MyArr, MaTK, MaKH, TuNgay, DenNgay

MaTK = Trim(Loc.Range("H6").Value)
MaKH = Trim(Loc.Range("H7").Value)
TuNgay = Trim(Loc.Range("D5").Value)
DenNgay = Trim(Loc.Range("D6").Value)

If MaTK = "" Or TuNgay = "" Or TuNgay = "" Then
MsgBox "Ban phai nhap day du Ma TK, Tu ngay, Den ngay", vbInformation, "Thông báo"
Else
On Error Resume Next

TuNgay = CDate(TuNgay)
DenNgay = CDate(DenNgay)

If Err.Number = 0 Then
Dim iRow As Long
iRow = TH.Range("AB65536").End(xlUp).Row
If iRow > 8 Then
Dim c As Long, r As Long, h As Long
Dim ur As Long
Dim Sum1 As Double, Sum2 As Double
Dim Arr As Variant

'Xac dinh hang cua du lieu truoc khi thuc hien:
Dim i As Long, j As Long, k As Long
i = Range("CongPS").Row
j = Range("NgayPS").Row

k = i - j
Range("NgayPS").Resize(k, 8).ClearContents

Arr = TH.Range("AB9:AK" & iRow).Value
ur = UBound(Arr, 1)

ReDim MyArr(1 To ur, 1 To 8)
If MaKH = "" Then
For r = 1 To ur
If Arr(r, 8) Like MaTK Or Arr(r, 9) Like MaTK Then
If Arr(r, 1) >= TuNgay And Arr(r, 1) <= DenNgay Then
h = h + 1
MyArr(h, 1) = Arr(r, 1)
MyArr(h, 2) = Arr(r, 2)
MyArr(h, 3) = Arr(r, 3)
MyArr(h, 4) = Arr(r, 5)
MyArr(h, 5) = Arr(r, 7)

If Arr(r, 8) Like MaTK Then
MyArr(h, 6) = Arr(r, 9)
MyArr(h, 7) = Arr(r, 10)
Sum1 = Sum1 + Arr(r, 10)
ElseIf Arr(r, 9) Like MaTK Then
MyArr(h, 6) = Arr(r, 8)
MyArr(h, 8) = Arr(r, 10)
Sum2 = Sum2 + Arr(r, 10)
End If
End If
End If
Next
Else
For r = 1 To ur
If Arr(r, 8) Like MaTK Or Arr(r, 9) Like MaTK Then
If Arr(r, 1) >= TuNgay And Arr(r, 1) <= DenNgay Then
If Arr(r, 6) Like MaKH Then
h = h + 1
MyArr(h, 1) = Arr(r, 1)
MyArr(h, 2) = Arr(r, 2)
MyArr(h, 3) = Arr(r, 3)
MyArr(h, 4) = Arr(r, 5)
MyArr(h, 5) = Arr(r, 7)

If Arr(r, 8) Like MaTK Then
MyArr(h, 6) = Arr(r, 9)
MyArr(h, 7) = Arr(r, 10)
Sum1 = Sum1 + Arr(r, 10)
ElseIf Arr(r, 9) Like MaTK Then
MyArr(h, 6) = Arr(r, 8)
MyArr(h, 8) = Arr(r, 10)
Sum2 = Sum2 + Arr(r, 10)
End If
End If
End If
End If
Next
End If
If h Then
With Loc
If k < h Then
r = h - k
.Range(.Cells(j + 1, 1), .Cells(j + r, 8)).Insert Shift:=xlDown
ElseIf k > h Then
r = k - h
.Range(.Cells(j + 1, 1), .Cells(j + r, 8)).Delete Shift:=xlUp
End If
End With
Range("NgayPS").Resize(h, 8) = MyArr
Range("CongPS") = Sum1
Range("CongPS").Offset(, 1) = Sum2
Else
Range("CongPS") = ""
Range("CongPS").Offset(, 1) = ""
With Loc
If k > 2 Then
r = k - 2
.Range(.Cells(j + 1, 1), .Cells(j + r, 8)).Delete Shift:=xlUp
End If
End With
End If
End If
Else
Err.Clear
MsgBox "Ban phai nhap dung kieu " _
& """ngay/ thang/ nam"" cac dieu kien " _
& "[Tu ngay] hoac [Den ngay]", _
vbInformation, "Thông báo"
End If
End If
End Sub
[/GPECODE]

 

[Hong.Van]

Lu bu với công việc, giờ mới làm tiếp phần dang dỡ buổi trưa đây. Tôi gửi file lên, nếu có gì chưa được thì ta lại làm tiếp hen!

Code trên chạy chính xác & rất nhanh!
Xin cảm ơn anh.

 

[VetMini]

@Hong.Van:
Xin lỗi bạn, lo lý sự quên mất bạn hỏi bài mới là chính.
Code tôi đề nghị là để thay thế cả nhóm code nằm trong vòng lặp FOR. Lý do chính là do code nguyên thuỷ có một đoạn code bị lặp lại. (Chuyện tách rời các lệnh IF's là chuyện phụ, không quan trọng)
Khi bạn thay vào, bạn không xoá block code thứ 2 nên số đếm k bị tăng dội.

Nếu muốn sửa thì sửa cả block FOR như thế này

For i = 1 To UBound(Data)
   If Data(i, 1) >= [D5].Value AND Data(i, 1) <= [D6].Value _ ' trong giới hạn ngày '
         AND ([H7].Value = "" OR Data(i, 6) = [H7].Value) _ ' đúng mã KH '
            AND (Data(i, 9) = [H6].Value Or Data(i, 8) = [H6].Value) Then ' dúng mã tài khoản đối chiếu '
               k = k + 1
               Res(k, 1) = Data(i, 1)
               Res(k, 2) = Data(i, 2)
               Res(k, 3) = Data(i, 3)
               Res(k, 4) = Data(i, 5)
               Res(k, 5) = Data(i, 7)
               ' If Data(i, 8) = [H6].Value Then Res(k, 6) = Data(i, 9) '
               ' If Data(i, 9) = [H6].Value Then Res(k, 6) = Data(i, 8) '
               ' If Data(i, 8) = [H6].Value Then Res(k, 7) = Data(i, 10) '
               ' If Data(i, 9) = [H6].Value Then Res(k, 8) = Data(i, 10) '
               ' điều kiện đã thử rồi, [H6].Value bắt buộc phải = Data(i, 8 hoặc 9) '
               Res(k, 6) = Data(i, Iif(Data(i, 8) = [H6].Value, 9, 8))
               Res(k, Iif(Data(i, 8) = [H6].Value, 7, 8)) = Data(i, 10)
   End If  
Next i

 

[quocphuoc88]

em xin mạo mụi hỏi 1 câu ạ :
Bài này chị Vân có 1 chỗ là số dư đầu kỳ chị dùng công thức để dò tìm trên bảng khác. Bây giờ tình huống đặt ra là giả sử ngày bắt đầu nó không là đầu tháng (1/1 ) mà nó là một ngày bất kỳ nào đó ( chẳng hạn như là ngày 15/1/2012 như tình huống trên ) thì lúc này số dư đầu kỳ nó sẽ thay đổi , không dùng công thức để vlookup được nữa. Vậy thì mình có thể viết được 1 code tính ra số dư đầu kỳ này được không ạ ? ( e nghĩ ra tình huống này vì lý do nếu sếp yêu cầu in ra bảng công nợ của 1 khách hàng từ thời gian nào đến thời gian nào đó bất kỳ )

 

[Hong.Van]

em xin mạo mụi hỏi 1 câu ạ :
Bài này chị Vân có 1 chỗ là số dư đầu kỳ chị dùng công thức để dò tìm trên bảng khác. Bây giờ tình huống đặt ra là giả sử ngày bắt đầu nó không là đầu tháng (1/1 ) mà nó là một ngày bất kỳ nào đó ( chẳng hạn như là ngày 15/1/2012 như tình huống trên ) thì lúc này số dư đầu kỳ nó sẽ thay đổi , không dùng công thức để vlookup được nữa. Vậy thì mình có thể viết được 1 code tính ra số dư đầu kỳ này được không ạ ? ( e nghĩ ra tình huống này vì lý do nếu sếp yêu cầu in ra bảng công nợ của 1 khách hàng từ thời gian nào đến thời gian nào đó bất kỳ )

Cái này đơn giản thôi, bạn dùng mẹo 1 tý là ra:
Giả sử bạn đã có số dư đầu kỳ của 1 mã khách nào rồi (Ví dụ ngày 01/01/2012)
Thì bạn chọn từ ngày 01/01/12 đến ngày 14/01/12 => như vậy bạn sẽ có số dư cuối ngày 14/01/12, bạn copy số sư này và Paste value vào thẳng số dư đầu kỳ hoặc để nó vào đâu đó rồi dùng Vlookup () để lấy. Sau đó bạn chọn từ ngày 15/01/12 đến ngày ngày nào đó thì sẽ ra kết qủa theo ý muốn của sếp bạn!
Thân!

 

[quocphuoc88]

ohm, sau e không nghĩ ra nhỉ . Nhưng e đang thử viết code luôn cho nó tính ra cái số dư đầu kỳ này thử xem sao !

 

[Hong.Van]

ohm, sau e không nghĩ ra nhỉ . Nhưng e đang thử viết code luôn cho nó tính ra cái số dư đầu kỳ này thử xem sao !

Code thì tôi kg biết viết ntn? nhưng cthức thì đơn giản thôi, dùng Vlookup với sumif hoặc Sumproduct là OK!

 

[quocphuoc88]

Code thì tôi kg biết viết ntn? nhưng cthức thì đơn giản thôi, dùng Vlookup với sumif hoặc Sumproduct là OK!

Dạ, nhưng e có 1 khách hàng chủ yếu thương mại làm toàn bộ trên excel, mới có 5 tháng đầu năm mà nó đã lên 8 ngàn dòng. Lúc trước e chưa biết code thì thèn này mỗi lần mở fiel lên là ngồi uống cà phê xong mới làm được ( toàn dùng công thức vlookup, sumproduct, sumif ) . Từ ngày biết chút đỉnh về code thì thằng này e không còn sợ mở file nó nữa.
Sẵn bài của chị hay, phù hợp với thằng khách hàng e nên e đang suy nghĩ viết vài dòng code cho nó tối ưu luôn !
Có gì mong chị chỉ bảo thêm ạ !