Tạo dòng TC khi sang tháng khác!

[ThuNghi]

Tôi có bảng kê gồm dữ liệu từ ngày 01/01/ - 31/12/....
Trong đó:
A: STT
B: Số HD
C: Ngày HD
D: DT
....
Nhờ các bạn lập hộ 1 VBA để chọn vùng dữ liệu và chọn ngày lớn nhất và cuối cùng của tháng đó thì chèn thêm 1 dòng và gám vào cột D hàm Subtotal()
Mấy hôm nay làm thủ công, hơi cực. Mà viết VBA thì khó quá
Xin chân thàm cám ơn.
Lưu ý: ngày cuối cùng của tháng có khi chỉ là ngày 20

 

[nvson]

ThuNghi hỏi bài này tương tự như bài mà Anhchanghamhoc đã hỏi

Option Explicit
Public Sub InsertCell()
On Error Resume Next
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim i As Long
Dim TLoi
TLoi = MsgBox("Ban co muon tao backup du lieu trong sheet hien hanh khong?", vbInformation + vbYesNo)
If TLoi = vbYes Then ActiveSheet.Copy Before:=ActiveSheet
Dim shtName As Worksheet
Set shtName = ActiveSheet
'Khoi tao gia tri bien i de xac dinh dong dau tien trong khoi du lieu
i = InputBox("Nhap dong du lieu dau tien trong vung du lieu can Insert", , 2)
If Err.Number <> 0 Then Exit Sub
Do
    i = i + 1
'Cot C chinh la cot ngay thang, ban dinh dang cho dung nhe!
    If Month(Cells(i, "[B]C[/B]")) <> Month(Cells(i - 1, "[B]C[/B]")) And Not IsEmpty(Cells(i - 1, "[B]C[/B]")) Then
        Rows(i).Select
        Selection.Insert Shift:=xlDown
    End If
Loop While i <= (ActiveSheet.UsedRange.Rows.Count + ActiveSheet.UsedRange.Row - 1)
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub

 

[ThuNghi]

Sorry, nhiều lúc sự việc cần làm thì lên 4R hỏi mà chưa chiụ kiểm tra. Mình sẽ vận dụng. Cám ơn nhiều!

 

[ThuNghi]

Cot C chinh la cot ngay thang, ban dinh dang cho dung nhe!Nhờ bạn nvson viết BS thêm MsgBox cột ngày tháng là ...C,D,....
Cám ơn rất nhiều!

 

[nvson]

Vậy bạn thử file sau nhé!

 

[ThuNghi]

Nhờ bạn xem lại hộ khi chọn tên cột C hay là c, chọn C thì OK mà c thì trục trặc. Với lại chỉ cần MsgBox là ok rôì, tạo form làm gì. Cám ơn!

 

[nvson]

Mình tạo ra form để cho giao diện gần gũi hơn với người sử dụng, dựa vào Code bạn có thể thay đổi tuỳ theo ý của bạn mà.
Khi mình tạo form thì không nghĩ bạn nhập trực tiếp số cột (mình muốn bạn chọn nó trên bảng tính).
Nếu bạn chỉ muốn nhập bằng hộp thoại thì sử dụng code sau:

Option Explicit
Public Sub InsertCell2()
On Error GoTo thoat
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim i As Long
Dim strCot As String
Dim TLoi
TLoi = MsgBox("Ban co muon tao backup du lieu trong sheet hien hanh khong?", vbInformation + vbYesNo)
If TLoi = vbYes Then ActiveSheet.Copy Before:=ActiveSheet
Dim shtName As Worksheet
Set shtName = ActiveSheet
'Khoi tao gia tri bien i de xac dinh dong dau tien trong khoi du lieu
i = InputBox("Nhap dong du lieu dau tien trong vung du lieu can Insert", , 2)
strCot = InputBox("Nhap ten cot ngay thang", , "C")
If Err.Number <> 0 Then Exit Sub
Do
    i = i + 1
'Cot C chinh la cot ngay thang, ban dinh dang cho dung nhe!
    If Month(Cells(i, strCot)) <> Month(Cells(i - 1, strCot)) And Not IsEmpty(Cells(i - 1, strCot)) Then
        Rows(i).Select
        Selection.Insert Shift:=xlDown
    End If
Loop While i <= (ActiveSheet.UsedRange.Rows.Count + ActiveSheet.UsedRange.Row - 1)
thoat:
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub

 

[dnphuonganh]

Nhờ các bạn lập hộ 1 VBA để chọn vùng dữ liệu và chọn ngày lớn nhất và cuối cùng của tháng đó thì chèn thêm 1 dòng và gán vào cột D hàm Subtotal()

Em thấy phương án giải quyết của anh nvson vẫn chưa thực hiện được việc tổng theo từng tháng cho cột D. Mong anh có thể giúp bổ sung theo ý tưởng: Sau khi chèn dòng sau khi tách tháng thì thực hiện việc xuất hiện MsgBox hỏi có muốn tính tổng theo từng tháng không, nếy chọn Yes thì thực hiện việc tính tổng, nếu chọn No thì thoát.
Cảm ơn anh!