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 các chị! Em có file dữ liệu muốn tách theo ngày như file đính kèm, nhờ các anh chị viết code giúp em với ạ. Em cảm ơn nhiều!
 

File đính kèm

Sắp xếp theo thời gian sắp xếp theo bầu chọn
LYSM đã viết:
Em chào các anh các chị! Em có file dữ liệu muốn tách theo ngày như file đính kèm, nhờ các anh chị viết code giúp em với ạ. Em cảm ơn nhiều!
Nhấp chuột vào đây để mở rộng...
Bạn dùng Code sau:
Mã: 
Sub Loc()
    Dim Arr, Res, TargetDate As Date
    Dim i As Long, j As Long, k As Long
    TargetDate = VBA.DateSerial(Sheet1.[E3], Sheet1.[D3], Sheet1.[C3])
    Arr = Sheet1.Range("A7:E" & Sheet1.Range("A65536").End(3).Row)
    ReDim Res(1 To UBound(Arr, 1), 1 To 6)
    For i = 1 To UBound(Arr, 1)
        If Arr(i, 1) + 1 = TargetDate Or Arr(i, 1) + 2 = TargetDate Or Arr(i, 1) + 7 = TargetDate 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, 4) / 6
            Res(k, 6) = Arr(i, 5)
        End If
    Next
    Sheet2.Range("A8:F65536").ClearContents
    Sheet2.Range("A8").Resize(k, 6) = Res
End Sub
 
Upvote 0
dhn46 đã viết:
Bạn dùng Code sau:
Mã: 
Sub Loc()
    Dim Arr, Res, TargetDate As Date
    Dim i As Long, j As Long, k As Long
    TargetDate = VBA.DateSerial(Sheet1.[E3], Sheet1.[D3], Sheet1.[C3])
    Arr = Sheet1.Range("A7:E" & Sheet1.Range("A65536").End(3).Row)
    ReDim Res(1 To UBound(Arr, 1), 1 To 6)
    For i = 1 To UBound(Arr, 1)
        If Arr(i, 1) + 1 = TargetDate Or Arr(i, 1) + 2 = TargetDate Or Arr(i, 1) + 7 = TargetDate 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, 4) / 6
            Res(k, 6) = Arr(i, 5)
        End If
    Next
    Sheet2.Range("A8:F65536").ClearContents
    Sheet2.Range("A8").Resize(k, 6) = Res
End Sub
Nhấp chuột vào đây để mở rộng...

bác ơi, bác chuyển nốt cho em công thức số tồn của cột E bên sheet "Du lieu vao" sang VBA với ạ
 
Upvote 0
LYSM đã viết:
bác ơi, bác chuyển nốt cho em công thức số tồn của cột E bên sheet "Du lieu vao" sang VBA với ạ
Nhấp chuột vào đây để mở rộng...
Thật không hiểu tại sao bạn lại muốn chuyển "Công thức" trong khi sheet "Mo mau" là sheet trích lọc các kết quả từ sheet "Dữ liệu vào" sang?

Nếu cần công thức tại sheet Mo mau thì bạn làm công thức luôn chứ VBA để làm gì?
 
Upvote 0
dhn46 đã viết:
Thật không hiểu tại sao bạn lại muốn chuyển "Công thức" trong khi sheet "Mo mau" là sheet trích lọc các kết quả từ sheet "Dữ liệu vào" sang?

Nếu cần công thức tại sheet Mo mau thì bạn làm công thức luôn chứ VBA để làm gì?
Nhấp chuột vào đây để mở rộng...
Bác nhiều nhầm ý em rồi ạ, em muốn chuyển đổi từ công thức sang VBA ở sheet "Du lieu vao" (công thức =IFERROR((6-MATCH(VALUE(DATE($E$3,$D$3,$C$3)-A7),$G$4:$I$4,1))*D7/6,D7) em muốn đưa luôn vào code), sheet "Mo mau" là chuẩn rồi ạ chứ không phải chuyển VBA về công thức. Vì file này có rất nhiều dữ liệu (khoảng 700 dòng) mà cùng 1 công thức lặp đi lặp lại sẽ rối nên em muốn chuyển sang VBA ạ
 
Lần chỉnh sửa cuối:
Upvote 0
LYSM đã viết:
Bác nhiều nhầm ý em rồi ạ, em muốn chuyển đổi từ công thức sang VBA ở sheet "Du lieu vao" (công thức =IFERROR((6-MATCH(VALUE(DATE($E$3,$D$3,$C$3)-A7),$G$4:$I$4,1))*D7/6,D7) em muốn đưa luôn vào code), sheet "Mo mau" là chuẩn rồi ạ chứ không phải chuyển VBA về công thức. Vì file này có rất nhiều dữ liệu (khoảng 700 dòng) mà cùng 1 công thức lặp đi lặp lại sẽ rối nên em muốn chuyển sang VBA ạ
Nhấp chuột vào đây để mở rộng...

Nếu bạn muốn đơn giản công thức thì có 2 cách:

#1_ lập công thức tự tạo trong VBA
#2_ đặt Name cho nó. :-=
 
Upvote 0
Đây là Code chuyển đổi công thức của bạn
Mã: 
Sub ChangeFormulas()
    Arr = Sheet1.Range("A7:E" & Sheet1.Range("A65536").End(3).Row)
    For i = 1 To UBound(Arr, 1)
        Select Case VBA.DateSerial(Sheet1.[E3], Sheet1.[D3], Sheet1.[C3]) - Arr(i, 1)
        Case Is < Sheet1.[G4]
            Arr(i, 5) = Arr(i, 4)
        Case Is = Sheet1.[G4]
            Arr(i, 5) = (6 - 1) * Arr(i, 4) / 6
        Case Is < Sheet1.[H4]
            Arr(i, 5) = (6 - 1) * Arr(i, 4) / 6
        Case Is < Sheet1.[I4]
            Arr(i, 5) = (6 - 2) * Arr(i, 4) / 6
        Case Is = Sheet1.[I4]
            Arr(i, 5) = (6 - 3) * Arr(i, 4) / 6
        Case Is > Sheet1.[I4]
            Arr(i, 5) = Arr(i, 4)
        End Select
    Next
    Sheet1.Range("A7").Resize(UBound(Arr, 1), 5) = Arr
End Sub
 
Upvote 0
dhn46 đã viết:
Đây là Code chuyển đổi công thức của bạn
Mã: 
Sub ChangeFormulas()
    Arr = Sheet1.Range("A7:E" & Sheet1.Range("A65536").End(3).Row)
    For i = 1 To UBound(Arr, 1)
        Select Case VBA.DateSerial(Sheet1.[E3], Sheet1.[D3], Sheet1.[C3]) - Arr(i, 1)
        Case Is < Sheet1.[G4]
            Arr(i, 5) = Arr(i, 4)
        Case Is = Sheet1.[G4]
            Arr(i, 5) = (6 - 1) * Arr(i, 4) / 6
        Case Is < Sheet1.[H4]
            Arr(i, 5) = (6 - 1) * Arr(i, 4) / 6
        Case Is < Sheet1.[I4]
            Arr(i, 5) = (6 - 2) * Arr(i, 4) / 6
        Case Is = Sheet1.[I4]
            Arr(i, 5) = (6 - 3) * Arr(i, 4) / 6
        Case Is > Sheet1.[I4]
            Arr(i, 5) = Arr(i, 4)
        End Select
    Next
    Sheet1.Range("A7").Resize(UBound(Arr, 1), 5) = Arr
End Sub
Nhấp chuột vào đây để mở rộng...
Em hỏi thêm một chút ạ, giờ em muốn số ngày là 1 tháng thì phải sửa code thế nào ạ? Vì tháng thừa tháng thiếu nên nếu sửa thành Arr(i,1)+30 =Targedate thì số ngày sẽ không đúng
 
Upvote 0
Chào bạn,

Mình không hiểu ý bạn muốn như thế nào? Bạn hãy mô tả cụ thể thêm 1 chút nữa.

Code bạn trích dẫn tại bài #9 chỉ là Code thay đổi công thức của bạn thôi.
 
Upvote 0
dhn46 đã viết:
Bạn dùng Code sau:
Mã: 
Sub Loc()
    Dim Arr, Res, TargetDate As Date
    Dim i As Long, j As Long, k As Long
    TargetDate = VBA.DateSerial(Sheet1.[E3], Sheet1.[D3], Sheet1.[C3])
    Arr = Sheet1.Range("A7:E" & Sheet1.Range("A65536").End(3).Row)
    ReDim Res(1 To UBound(Arr, 1), 1 To 6)
    For i = 1 To UBound(Arr, 1)
        [B]If Arr(i, 1) + 1 = TargetDate Or Arr(i, 1) + 2 = TargetDate Or Arr(i, 1) + 7 = TargetDate Then
          [/B]  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, 4) / 6
            Res(k, 6) = Arr(i, 5)
        End If
    Next
    Sheet2.Range("A8:F65536").ClearContents
    Sheet2.Range("A8").Resize(k, 6) = Res
End Sub
Nhấp chuột vào đây để mở rộng...
Chào bác, cụ thể là dòng bôi đậm ấy, em có 1 nhóm sản phẩm cần tách theo 1 tháng, 3 tháng v.v.. VD sản xuất 15/2 thì sẽ tách vào ngày 15/3 (1tháng nhưng chỉ có 28 ngày). Nhưng nếu sản xuất 15/3 thì tách 15/4 (cũng là 1 tháng nhưng lại là 31 ngày). Nên ko thể thay dòng trên là 30 ngày, 90 ngày được vì tháng có tháng thiếu có tháng thừa. Mong bác giúp đỡ
 
Upvote 0
Chào bạn,

Quả thật mình không hiểu bởi tách như thế nào là việc mang tính chất chuyên ngành, mình chỉ giúp được theo yêu cầu cụ thể thôi.

Mình chỉ đoán như sau:

Với Code trên thì làm theo yêu cầu bài #1. Nếu mình hiểu đúng thì bạn muốn tách theo 30, 31 ngày hoặc số ngày cụ thể. Nếu đúng bạn sửa đoạn này
Mã: 
If Arr(i, 1) + 1 = TargetDate Or Arr(i, 1) + 2 = TargetDate Or Arr(i, 1) + 7 = TargetDate

thành

Mã: 
Arr(i, 1) +[COLOR=#ff0000][B] [SIZE=5]7[/SIZE][/B][/COLOR] = TargetDate
Bạn sửa số 7 thành số mong muốn, nếu muốn nhiều điều kiện thì sửa tương tự tại code đầu tiên và thay số

hoặc nếu bạn muốn chủ động số ngày thì bạn thay bởi Code
Mã: 
Arr(i, 1) +[COLOR=#FF0000][B] [SIZE=5]sheet1.[A1][/SIZE][/B][/COLOR] = TargetDate

trong đó A1 là giá trị số ngày bạn muốn tách

Hy vọng là hiểu đúng ý bạn
 
Upvote 0
dhn46 đã viết:
Chào bạn,

Quả thật mình không hiểu bởi tách như thế nào là việc mang tính chất chuyên ngành, mình chỉ giúp được theo yêu cầu cụ thể thôi.

Mình chỉ đoán như sau:

Với Code trên thì làm theo yêu cầu bài #1. Nếu mình hiểu đúng thì bạn muốn tách theo 30, 31 ngày hoặc số ngày cụ thể. Nếu đúng bạn sửa đoạn này
Mã: 
If Arr(i, 1) + 1 = TargetDate Or Arr(i, 1) + 2 = TargetDate Or Arr(i, 1) + 7 = TargetDate

thành

Mã: 
Arr(i, 1) +[COLOR=#ff0000][B] [SIZE=5]7[/SIZE][/B][/COLOR] = TargetDate
Bạn sửa số 7 thành số mong muốn, nếu muốn nhiều điều kiện thì sửa tương tự tại code đầu tiên và thay số

hoặc nếu bạn muốn chủ động số ngày thì bạn thay bởi Code
Mã: 
Arr(i, 1) +[COLOR=#FF0000][B] [SIZE=5]sheet1.[A1][/SIZE][/B][/COLOR] = TargetDate

trong đó A1 là giá trị số ngày bạn muốn tách

Hy vọng là hiểu đúng ý bạn
Nhấp chuột vào đây để mở rộng...
Em hiểu đoạn code đó, ý em muốn là tách theo 1 tháng (tháng thì có tháng 30, 31 ngày) chứ không phải 30 hay 31 ngày nhưng không biết có hàm tách theo đơn vị là tháng ko?
 
Upvote 0
Bạn dùng
Mã: 
Arr(i, 1) = VBA.DateSerial(Year(TargetDate), Month(TargetDate) + 1, Day(TargetDate))

Nếu bạn chú ý thì bạn cứ bám vào Dateserial ở Code bên trên là có thể sửa được
 
Upvote 0
Mã: 
If Arr(i, 1) + 1 = TargetDate Or Arr(i, 1) + 2 = TargetDate Or Arr(i, 1) + 7 = TargetDate
Nếu cần tìm hạn đúng ngày thì cách cộng ngày cho từng điểm tính là cách kém hữu hiệu. Cứ mỗi dòng dữ liệu lại phải lặp lai con toán tính ?????

Trong trường hợp này, người ta trừ số tháng/ngày ra khỏi TargetDate rồi so sánh với ngày của dữ liệu. Như vậy chỉ phải tính một loạt ngày thôi.

code như vầy:

Mã: 
TDate1 = DateAdd("m", -1, TargetDate) ' 1 thàng trước ngày mở mẫu
TDate2 = DateAdd("m", -3, TargetDate) ' 3 tháng trước ngày mở mẫu
...
If Arr(i, 1) TDate1 Or Arr(i, 1) = TDate2 Or Arr(i, 1) = TDate3 ...
 
Lần chỉnh sửa cuối:
Upvote 0
VetMini đã viết:
Mã: 
If Arr(i, 1) + 1 = TargetDate Or Arr(i, 1) + 2 = TargetDate Or Arr(i, 1) + 7 = TargetDate
Nếu cần tìm hạn đúng ngày thì cách cộng ngày cho từng điểm tính là cách kém hữu hiệu. Cứ mỗi dòng dữ liệu lại phải lặp lai con toán tính ?????

Trong trường hợp này, người ta trừ số tháng/ngày ra khỏi TargetDate rồi so sánh với ngày của dữ liệu. Như vậy chỉ phải tính một loạt ngày thôi.

code như vầy:

Mã: 
TDate1 = DateAdd("m", -1, TargetDate) ' 1 thàng trước ngày mở mẫu
TDate2 = DateAdd("m", -3, TargetDate) ' 3 tháng trước ngày mở mẫu
...
If Arr(i, 1) TDate1 Or Arr(i, 1) = TDate2 Or Arr(i, 1) = TDate3 ...
Nhấp chuột vào đây để mở rộng...

Bác ơi, em có 1 rắc rối khi chuyển về tháng là nếu rơi vào tháng thừa, thiếu. Ví dụ Dateadd("m",-1,datererial(2014,2,28)) thì nó trả về ngày 28/1, nhưng ngày 29, 30, 31/1 thì không biết phải làm như thế nào vì không có ngày 29, 30, 31 tháng 2. Em thử trong công thức sẵn có của excel thì nó sẽ lấy ngày 01,02,03 tháng 3 nhưng trong VBA những ngày này bị bỏ qua luôn. Em tải file lên cho bác dễ hình dung Mong bác giúp đỡ
 

File đính kèm

Lần chỉnh sửa cuối:
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 (1 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
    • Yêu thích
Trả lời
0
Đọc
12
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
198
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
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 (2 người xem)
Trả lời
7
Đọc
273
tranhungdao12a3
T
H
Tổng hợp Công Nợ theo Công trình (3 người xem)
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ọ
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
    • 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 (2 người xem)
    • Yêu thích
Trả lời
12
Đọc
360
phuongnam366377
phuongnam366377
L
File Excel nặng chưa tìm được lý do ở đâu . Mong các bác hỗ trợ ! (3 người xem)
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 (1 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 (1 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 (1 người xem)
    • 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
Trả lời
2
Đọc
140
linedraw84
L
H
Xin File Theo dõi công nợ (2 người xem)
Trả lời
0
Đọc
115
HangktGTN
H
N
Tạo file Excel dùng VBA để lấy và nối dữ liệu từ các files excel
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