Xin code tách dữ liệu theo ngày tháng (1 người xem)

  • Thread starter Thread starter LYSM
  • Ngày gửi Ngày gửi
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)
L

LYSM

Thành viên thường trực
Tham gia
16/3/11
Bài viết
290
Được thích
26
Em chào các anh chị! Sau một hồi "mò" em cũng cho ra được code tach dữ liệu theo ngày tháng (file đính kèm). Tại sub "Tach" đã hoạt động đúng yêu cầu nhưng các giá trị res(k,5) =Nullstring nó vẫn cho ra kết quả, em không muốn những giá trị Res mà có Res(k,5)=nullstring xuất hiện bên sheet "Mo mau" nhưng em làm không được (thay sheet1.[C7]=25 sẽ thấy ạ), nhờ mọi người sửa lại code "tach" giúp em theo yêu cầu trên và cho nó chạy "tốc độ" một chút, sub chạy chậm quá. Em sửa thành sub "Tach1" thì càng chẳng ra cái gì.
Xin cảm ơn mọi người!
Chúc mọi người cuối tuần vui vẻ!
 

File đính kèm

Lần chỉnh sửa cuối:
Sắp xếp theo thời gian sắp xếp theo bầu chọn
mình chưa hiểu được bạn giải thích lỗi đó nhưng thấy code trong sub Tach() tại dòng
ngay7 = DateSerial(.[e7], .[d7], .[c7] - .[L8] * 7) '---> đk row này là tháng đúng ra phải *30 chứ nhỉ :-=

' - - - - -
các giá trị bạn khai báo ngay1...ngay14 để dễ theo dõi kết quả thì bạn nên tạo thêm 1 row phụ (bạn xem file đính kèm, row 9) ---> code của SUb Tach() cũng đơn giản hơn.

'- - - - -
muốn "tốc độ" thì bạn thêm: vào đầu và đuôi của code
Mã: 
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual 'tuỳ trường hợp
'macro ...
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

'- - - - -
code lọc số liệu của bạn na ná giống với bài này, và đã có lời giải tách dữ liệu theo mã số, code bị lỗi
'- - -
file hoàn chỉnh tại #13
 
Lần chỉnh sửa cuối:
Upvote 0
phucbugis đã viết:
mình chưa hiểu được bạn giải thích lỗi đó nhưng thấy code trong sub Tach() tại dòng
ngay7 = DateSerial(.[e7], .[d7], .[c7] - .[L8] * 7) '---> đk row này là tháng đúng ra phải *30 chứ nhỉ :-=

' - - - - -
các giá trị bạn khai báo ngay1...ngay14 để dễ theo dõi kết quả thì bạn nên tạo thêm 1 row phụ (bạn xem file đính kèm, row 9) ---> code của SUb Tach() cũng đơn giản hơn.

'- - - - -
muốn "tốc độ" thì bạn thêm: vào đầu và đuôi của code
Mã: 
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
'macro ...
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

'- - - - -
code lọc số liệu của bạn na ná giống với bài này, và đã có lời giải tách dữ liệu theo mã số, code bị lỗi
Nhấp chuột vào đây để mở rộng...

Không giống đâu bác ơi, file đính kèm bác đưa cho em nội dung vẫn như thế, vẫn chưa loại được các res(k,5)=nullString (bác cứ đổi ngày mở mẫu thành 25 /2 là biết. Cho ngay7 đến ngay 13 là em để theo tổng quát, ở đây ngày là 0. Đến điều kiện if thì cho thêm tháng ạ :D
 
Upvote 0
LYSM đã viết:
Không giống đâu bác ơi, file đính kèm bác đưa cho em nội dung vẫn như thế, vẫn chưa loại được các res(k,5)=nullString (bác cứ đổi ngày mở mẫu thành 25 /2 là biết. Cho ngay7 đến ngay 13 là em để theo tổng quát, ở đây ngày là 0. Đến điều kiện if thì cho thêm tháng ạ :D
Nhấp chuột vào đây để mở rộng...

mình đã chỉnh lại code nhưng chưa hiểu rõ điều kiện bạn đặt ra ---> bạn kiểm tra kết quả sao nhé. Nếu ko đúng thì bạn cho ví dụ + kết quả mong muốn luôn nhé.

'- - -
file hoàn chỉnh tại #13
 
Lần chỉnh sửa cuối:
Upvote 0
phucbugis đã viết:
mình đã chỉnh lại code nhưng chưa hiểu rõ điều kiện bạn đặt ra ---> bạn kiểm tra kết quả sao nhé. Nếu ko đúng thì bạn cho ví dụ + kết quả mong muốn luôn nhé.
Nhấp chuột vào đây để mở rộng...
Kết quả này không phải bác ạ, như sub tach của em là gần được rồi, chỉ còn 1 cái nữa là nó vẫn hiện ra những kết quả có res(k,5) = NullString . VD em xoá ngày 24/2/2014 ở cell V58 (sheet1) thì ở sheet mo mau vẫn hiện ra 1 bảng danh sách nhưng cột E thì trống, em không muốn những sản phẩm không có số lượng đó hiện ra nữa. Đại khái là như này:
khi res(k,5)=Nullstring thì code sẽ bỏ qua các dòng lệnh
k = k + 1
Res(k, 1) = k
Res(k, 2) = Arr(i, 1)
Res(k, 3) = Arr(i, 2)
Res(k, 4) = Arr(i, 3)
Res(k, 6) = Arr(i, 5)
các dòng trên chỉ được thực hiện khi res(k,5)<>NullString. Mà Res(k,5) =Arr(I,6) đến Arr(I,19) nghĩa là vùng từ F12:S12 đó
 
Upvote 0
Mình chưa hiểu về VBA các anh chị có cách nào giúp mình tìm hiểu với!
Thanks:=\+
 
Upvote 0
Em sửa lại chút chỗ DateAdd của 2 trường hợp ạ. Lấy VD nữa cho dễ hình dung: Em muốn điều kiện như sau:
chẳng hạn đối với ngay1:
If DateAdd("m", .[F7], Arr(i, 1)) = ngay1 and Arr(I,6) <> NullString Then
k = k + 1
Res(k, 1) = k
Res(k, 2) = Arr(i, 1)
Res(k, 3) = Arr(i, 2)
Res(k, 4) = Arr(i, 3)
Res(k, 5) = Arr(i,6 )
Res(k, 6) = Arr(i, 5)
end if

tương tự với ngay2
If DateAdd("m", .[G7], Arr(i, 1)) = ngay2 and Arr(I,7) <> NullString Then
k = k + 1
Res(k, 1) = k
Res(k, 2) = Arr(i, 1)
Res(k, 3) = Arr(i, 2)
Res(k, 4) = Arr(i, 3)
Res(k, 5) = Arr(i,7 )
Res(k, 6) = Arr(i, 5)
end if
tương tự như thế đến hết. Nhưng viết code như vậy thì dài quá mà chạy rất chậm ạ
 
Lần chỉnh sửa cuối:
Upvote 0
đoạn code trên bạn giải thích so với đoạn code bạn đã cài trong Sub tach() thì khác rất xa đó --=0

Mã: 
For i = 1 To UBound(Arr, 1)
   
        If Arr(i, 2) <> NullString Then
        If DateAdd("m", .[F7], Arr(i, 1)) = ngay1 Or _
        DateAdd("m", .[G7], Arr(i, 1)) = ngay2 Or _
        DateAdd("m", .[H7], Arr(i, 1)) = ngay3 Or _
        DateAdd("m", .[I7], Arr(i, 1)) = ngay4 Or _
        DateAdd("m", .[J7], Arr(i, 1)) = ngay5 Or _
        DateAdd("m", .[K7], Arr(i, 1)) = ngay6 Or _
        DateAdd("m", .[L7], Arr(i, 1)) = ngay7 Or _
        DateAdd("m", .[M7], Arr(i, 1)) = ngay8 Or _
        DateAdd("m", .[N7], Arr(i, 1)) = ngay9 Or _
        DateAdd("m", .[O7], Arr(i, 1)) = ngay10 Or _
        DateAdd("m", .[P7], Arr(i, 1)) = ngay11 Or _
        DateAdd("m", .[Q7], Arr(i, 1)) = ngay12 Or _
        DateAdd("m", .[R7], Arr(i, 1)) = ngay13 Or _
        DateAdd("yyyy", 1, Arr(i, 1)) = ngay14 Then
            k = k + 1
            Res(k, 1) = k
            Res(k, 2) = Arr(i, 1)
            Res(k, 3) = Arr(i, 2)
            Res(k, 4) = Arr(i, 3)
            Res(k, 6) = Arr(i, 5)
        End If
        If DateAdd("m", .[F7], Arr(i, 1)) = ngay1 Then Res(k, 5) = Arr(i, 6)
        If DateAdd("m", .[G7], Arr(i, 1)) = ngay2 Then Res(k, 5) = Arr(i, 7)
        If DateAdd("m", .[H7], Arr(i, 1)) = ngay3 Then Res(k, 5) = Arr(i, 8)
        If DateAdd("m", .[I7], Arr(i, 1)) = ngay4 Then Res(k, 5) = Arr(i, 9)
        If DateAdd("m", .[J7], Arr(i, 1)) = ngay5 Then Res(k, 5) = Arr(i, 10)
        If DateAdd("m", .[K7], Arr(i, 1)) = ngay6 Then Res(k, 5) = Arr(i, 11)
        If DateAdd("m", .[L7], Arr(i, 1)) = ngay7 Then Res(k, 5) = Arr(i, 12)
        If DateAdd("m", .[M7], Arr(i, 1)) = ngay8 Then Res(k, 5) = Arr(i, 13)
        If DateAdd("m", .[N7], Arr(i, 1)) = ngay9 Then Res(k, 5) = Arr(i, 14)
        If DateAdd("m", .[O7], Arr(i, 1)) = ngay10 Then Res(k, 5) = Arr(i, 15)
        If DateAdd("m", .[P7], Arr(i, 1)) = ngay11 Then Res(k, 5) = Arr(i, 16)
        If DateAdd("m", .[Q7], Arr(i, 1)) = ngay12 Then Res(k, 5) = Arr(i, 17)
        If DateAdd("m", .[R7], Arr(i, 1)) = ngay13 Then Res(k, 5) = Arr(i, 18)
        If DateAdd("yyyy", 1, Arr(i, 1)) = ngay14 Then Res(k, 5) = Arr(i, 19)
        End If
         
     Next
 
Lần chỉnh sửa cuối:
Upvote 0
Như file này là hoàn chỉnh ạ, nhưng viết như vậy nó thủ công quá, dữ liệu bên em lại nhiều (gần 10000 dòng) nên code chạy sẽ ì ạch. Các anh chị tăng tốc nó hộ em với
 

File đính kèm

Upvote 0
phucbugis đã viết:
đoạn code trên bạn giải thích so với đoạn code bạn đã cài trong Sub tach() thì khác rất xa đó --=0

Mã: 
For i = 1 To UBound(Arr, 1)
   
        If Arr(i, 2) <> NullString Then
        If DateAdd("m", .[F7], Arr(i, 1)) = ngay1 Or _
        DateAdd("m", .[G7], Arr(i, 1)) = ngay2 Or _
        DateAdd("m", .[H7], Arr(i, 1)) = ngay3 Or _
        DateAdd("m", .[I7], Arr(i, 1)) = ngay4 Or _
        DateAdd("m", .[J7], Arr(i, 1)) = ngay5 Or _
        DateAdd("m", .[K7], Arr(i, 1)) = ngay6 Or _
        DateAdd("m", .[L7], Arr(i, 1)) = ngay7 Or _
        DateAdd("m", .[M7], Arr(i, 1)) = ngay8 Or _
        DateAdd("m", .[N7], Arr(i, 1)) = ngay9 Or _
        DateAdd("m", .[O7], Arr(i, 1)) = ngay10 Or _
        DateAdd("m", .[P7], Arr(i, 1)) = ngay11 Or _
        DateAdd("m", .[Q7], Arr(i, 1)) = ngay12 Or _
        DateAdd("m", .[R7], Arr(i, 1)) = ngay13 Or _
        DateAdd("yyyy", 1, Arr(i, 1)) = ngay14 Then
            k = k + 1
            Res(k, 1) = k
            Res(k, 2) = Arr(i, 1)
            Res(k, 3) = Arr(i, 2)
            Res(k, 4) = Arr(i, 3)
            Res(k, 6) = Arr(i, 5)
        End If
        If DateAdd("m", .[F7], Arr(i, 1)) = ngay1 Then Res(k, 5) = Arr(i, 6)
        If DateAdd("m", .[G7], Arr(i, 1)) = ngay2 Then Res(k, 5) = Arr(i, 7)
        If DateAdd("m", .[H7], Arr(i, 1)) = ngay3 Then Res(k, 5) = Arr(i, 8)
        If DateAdd("m", .[I7], Arr(i, 1)) = ngay4 Then Res(k, 5) = Arr(i, 9)
        If DateAdd("m", .[J7], Arr(i, 1)) = ngay5 Then Res(k, 5) = Arr(i, 10)
        If DateAdd("m", .[K7], Arr(i, 1)) = ngay6 Then Res(k, 5) = Arr(i, 11)
        If DateAdd("m", .[L7], Arr(i, 1)) = ngay7 Then Res(k, 5) = Arr(i, 12)
        If DateAdd("m", .[M7], Arr(i, 1)) = ngay8 Then Res(k, 5) = Arr(i, 13)
        If DateAdd("m", .[N7], Arr(i, 1)) = ngay9 Then Res(k, 5) = Arr(i, 14)
        If DateAdd("m", .[O7], Arr(i, 1)) = ngay10 Then Res(k, 5) = Arr(i, 15)
        If DateAdd("m", .[P7], Arr(i, 1)) = ngay11 Then Res(k, 5) = Arr(i, 16)
        If DateAdd("m", .[Q7], Arr(i, 1)) = ngay12 Then Res(k, 5) = Arr(i, 17)
        If DateAdd("m", .[R7], Arr(i, 1)) = ngay13 Then Res(k, 5) = Arr(i, 18)
        If DateAdd("yyyy", 1, Arr(i, 1)) = ngay14 Then Res(k, 5) = Arr(i, 19)
        End If
         
     Next
Nhấp chuột vào đây để mở rộng...
không khác đâu bác ợ em hơi nhầm chút phần dateAdd (đã sửa lại) ở #8, chỉ có đoạn trong sub tach em không làm sao cho được điều kiện arr(i,j) <> nullstring (for j=6 to 19) vào thôi ạ nên em mới phải thêm 1 loạt if...then Res(k,5)=Arr(i,6(7,8,9...)) vào ạ
 
Upvote 0
LYSM đã viết:
Như file này là hoàn chỉnh ạ, nhưng viết như vậy nó thủ công quá, dữ liệu bên em lại nhiều (gần 10000 dòng) nên code chạy sẽ ì ạch. Các anh chị tăng tốc nó hộ em với
Nhấp chuột vào đây để mở rộng...

bạn đưa file này lên sớm có vẻ khoẻ hơn ko :-=, do dữ liệu đặc thù quá ---> nhìn khó hiểu.

mong bạn sớm có được câu trả lời từ mọi người !
 
Upvote 0
LYSM đã viết:
không khác đâu bác ợ em hơi nhầm chút phần dateAdd (đã sửa lại) ở #8, chỉ có đoạn trong sub tach em không làm sao cho được điều kiện arr(i,j) <> nullstring (for j=6 to 19) vào thôi ạ nên em mới phải thêm 1 loạt if...then Res(k,5)=Arr(i,6(7,8,9...)) vào ạ
Nhấp chuột vào đây để mở rộng...

mình đã chỉnh code + test thành công (ko cần phải viết dài như code gốc của bạn nữa)
Mã: 
Sub Tach()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
    Dim Arr, Res
    Dim i As Long, k As Long, n As Long
    With Sheet1
        Arr = .Range("A13:U" & .Range("A65536").End(3).Row)
        ReDim Res(1 To UBound(Arr, 1), 1 To 21)
        
        For i = 1 To UBound(Arr, 1)
            If Arr(i, 2) <> NullString Then
                For n = 6 To 19
                    If DateAdd("m", .Cells(7, n), Arr(i, 1)) = .Cells(10, n) And _
                    Arr(i, n) <> NullString Then
                        k = k + 1
                        Res(k, 1) = k
                        Res(k, 2) = Arr(i, 1)
                        Res(k, 3) = Arr(i, 2)
                        Res(k, 4) = Arr(i, 3)
                        
                        Res(k, 5) = Arr(i, n)
                        
                        Res(k, 6) = Arr(i, 5)
                    End If
                Next n
            End If
         Next
    End With
   
    Sheet2.Range("A8:F65536").ClearContents
    If k Then Sheet2.Range("A8").Resize(k, 6) = Res

    MsgBox ("xong sub tach")
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub

mình còn chưa hiểu đoạn dưới trong file gốc + thêm số liệu cột này ko có --> chưa thử được
Mã: 
        If DateAdd("yyyy", 1, Arr(i, 1)) = ngay14 And Arr(i, 19) <> NullString Then
            k = k + 1
            Res(k, 1) = k
            Res(k, 2) = Arr(i, 1)
            Res(k, 3) = Arr(i, 2)
            Res(k, 4) = Arr(i, 3)
            Res(k, 5) = Arr(i, 19)
            Res(k, 6) = Arr(i, 5)
        End If

Link: https://www.mediafire.com/?927xcym9p9y7kmt
 
Lần chỉnh sửa cuối:
Upvote 0
phucbugis đã viết:
mình đã chỉnh code + test thành công (ko cần phải viết dài như code gốc của bạn nữa)
Mã: 
Sub Tach()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
    Dim Arr, Res
    Dim i As Long, k As Long, n As Long
    With Sheet1
        Arr = .Range("A13:U" & .Range("A65536").End(3).Row)
        ReDim Res(1 To UBound(Arr, 1), 1 To 21)
        
        For i = 1 To UBound(Arr, 1)
            If Arr(i, 2) <> NullString Then
                For n = 6 To 19
                    If DateAdd("m", .Cells(7, n), Arr(i, 1)) = .Cells(10, n) And _
                    Arr(i, n) <> NullString Then
                        k = k + 1
                        Res(k, 1) = k
                        Res(k, 2) = Arr(i, 1)
                        Res(k, 3) = Arr(i, 2)
                        Res(k, 4) = Arr(i, 3)
                        
                        Res(k, 5) = Arr(i, n)
                        
                        Res(k, 6) = Arr(i, 5)
                    End If
                Next n
            End If
         Next
    End With
   
    Sheet2.Range("A8:F65536").ClearContents
    If k Then Sheet2.Range("A8").Resize(k, 6) = Res

    MsgBox ("xong sub tach")
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub

mình còn chưa hiểu đoạn dưới trong file gốc + thêm số liệu cột này ko có --> chưa thử được
Mã: 
        If DateAdd("yyyy", 1, Arr(i, 1)) = ngay14 And Arr(i, 19) <> NullString Then
            k = k + 1
            Res(k, 1) = k
            Res(k, 2) = Arr(i, 1)
            Res(k, 3) = Arr(i, 2)
            Res(k, 4) = Arr(i, 3)
            Res(k, 5) = Arr(i, 19)
            Res(k, 6) = Arr(i, 5)
        End If
Nhấp chuột vào đây để mở rộng...
vâng, code này thì đúng rồi ạ, nhưng có cách nào bỏ dòng số 10 đi được không bác?
 
Upvote 0
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.

Bài viết mới nhất

B
Mình có làm đoạn code VBA trong file access mà cứ báo lỗi nhờ mọi người hướng dẫn (2 người xem)
Trả lời
4
Đọc
95
ptm0412
ptm0412
GPE-Trợ Lý
CHÀO MỪNG 80 NĂM QUỐC KHÁNH (6 người xem)
    • Yêu thích
Trả lời
0
Đọc
14
GPE-Trợ Lý
GPE-Trợ Lý
Tuanba1992
Lập trình Excel có thể dùng ngôn ngữ lập trình nào? (1 người xem)
Trả lời
5
Đọc
200
Tuanba1992
Tuanba1992
thanhss
Tự động lấy dữ liệu từ các sheet khác đưa vào sheet tổng hợp khi chọn Ngày hoặc tháng hoặc năm (1 người xem)
Trả lời
21
Đọc
223
thanthanhan
thanthanhan
vuthaiha90
Lọc dữ liệu không trùng và trả kết quả về 1 dòng
Trả lời
7
Đọc
274
tranhungdao12a3
T
H
Tổng hợp Công Nợ theo Công trình
Trả lời
26
Đọc
332
DeTong
D
T
Nhờ anh chị xem giúp file bị lỗi gì mà chạy rất chậm/lag - File tính tiền nhà trọ (2 người xem)
Trả lời
10
Đọc
386
Thaik05
T
Nguyễn Duy Tuân
Hàm BS COMBINLIST Liệt kê các giá trị tổ hợp, chỉnh hợp, chỉnh hợp không lặp | Add-in A-Tools v10 (1 người xem)
    • Yêu thích
    • Thích
Trả lời
24
Đọc
2K
nguyendang95
N
J
Xử lý các file Excel bị nặng sau nhiều năm sử dụng
Trả lời
13
Đọc
2K
huhumalu
H
hongphuong1997
Nên sử dụng Chatgpt hay Copilot (1 người xem)
    • Yêu thích
Trả lời
12
Đọc
361
phuongnam366377
phuongnam366377
L
File Excel nặng chưa tìm được lý do ở đâu . Mong các bác hỗ trợ !
Trả lời
5
Đọc
137
PhanTuHuong
PhanTuHuong
U
VB tính tổng số cell trong 1 hàng có cùng màu với 1 cell so sánh ở cột khác
Trả lời
5
Đọc
91
Hoàng Tuấn 868
H
T
VBA LẤY THÔNG TIN TRÊN TỜ KHAI NHẬP KHẨU (2 người xem)
Trả lời
10
Đọc
663
binhminh1408
B
H
Giúp mình ghép nhiều file thành một file.
Trả lời
10
Đọc
461
hanhnguyen120221cuty
H
2
  • Question Question
Hỏi cách in phiếu điều tra PCGD-XMC từ file dữ liệu mẫu xuất ra từ hệ thống PCGD-XMC của Bộ GD (3 người xem)
    • Thích
Trả lời
18
Đọc
1K
Hoàng Tuấn 868
H
HeSanbi
  • Đã giải quyết
ZaloExcel v2.96: Gửi tin nhắn, hình ảnh, bảng, biểu đồ, tập tin, tạo nhóm, thu thập tin nhắn
    • Thích
    • Cảm ơn
    • Yêu thích
Trả lời
60
Đọc
20K
HeSanbi
HeSanbi
D
XIN HỖ TRỢ VỀ FILE EXCEL TỔNG HỢP ĐIỂM THI ĐUA
Trả lời
0
Đọc
62
DươngH193
D
L
Xin file lịch báo giảng tự động (2 người xem)
Trả lời
2
Đọc
140
linedraw84
L
H
Xin File Theo dõi công nợ
Trả lời
0
Đọc
116
HangktGTN
H
N
Tạo file Excel dùng VBA để lấy và nối dữ liệu từ các files excel (1 người xem)
Trả lời
39
Đọc
7K
hungnv_thct2026
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

Thời gian đếm ngược.

000
Ngày
00
Giờ
00
phút
00
giây
Thân mời tham dự sự kiện sinh nhật GPE 2025
Back
Top Bottom