Hỏi về chèn dòng có điều kiện kết hợp tự động điền dòng chữ (vào dòng vừa chèn) (1 người xem)

[Dauthivan]

Bài toán hôm qua nhờ mọi người góp ý, buổi hôm nay ngồi nghiên cứu viết Code giờ em đã bắt đầu quen dần. Hiện tại, bản thân em đã có thể tự làm được các kiểu bài tương tự rồi.

Em xin nhờ mọi người giúp em thêm 01 bài toán:

Yêu cầu của đầu bài: Tại mỗi dòng cuối của tất cả công việc, làm thế nào để sau khi chạy Code thì mỗi công việc được tự động chèn thêm 2 dòng, đồng thời nội dung của từng dòng được đánh nội dung vào luôn như sau:
- Dòng thứ nhất xuất hiện dòng chữ: Chi phí chung
- Dòng thứ 2 xuất hiện dòng chữ: Thu nhập chịu thuế tính trước

Trên màn hình kết quả hình ảnh sau khi chèn dòng màu vàng (em làm mẫu công việc số 1)

 

[ptm0412]

Đối với việc chèn dòng, xoá dòng, tính tổng phía dưới (Subtotal nằm trên), ... tốt nhất là nên quét ngược từ dưới lên, lý do:
- Số vòng lặp cố định và ít hơn vì không cộng thêm
- Số cộng thêm có nhiều những trường hợp không biết trước (bài này biết trước = 4 x 2 = 8)

 

[Dauthivan]

Với bài này, ta đã xác định ở cột A, khi gặp cell có dữ liệu thì chèn 2 dòng & gán giá trị, nếu Bé Còi chơi kiểu "nhảy cà tưng" từ dưới lên (sử dụng Do....Loop While & End(XlUp)) thì vòng lặp chỉ nhảy 3 bước là xong, nếu dùng For ...Next phải chạy đủ số dòng. Mình chỉ cảm giác như thế thôi chứ mình hổng biết làm, nếu Còi không làm được thì nhờ Lão Chết Tiệt làm giúp nhé. Hihi
Híc

Nếu bây giờ chỉ xét đến bài toán chèn dòng thôi, Code của bác hoamattroicoi lúc này là:

Sub inSertRow()
Dim fRow, lRow
Dim i As Long
fRow = 4
lRow = Cells(65536, 3).End(xlUp).Row
For i = lRow + 1 To fRow + 2 Step -1
With Cells(i, 1)
    If .Value <> "" Or i = lRow + 1 Then
        .Resize(2, 1).EntireRow.Insert
                    End If
    End With
Next
End Sub

Cái khó theo em là khi chuyển sang Do Loop While bản thân Loop While nó bị ràng buộc 2 điều kiện: Cells(i, 1).Value <> "" và i, nên em không biết phải viết thế nào.

(Em làm từ sáng không được, em xin mọi người giới thiệu giúp em một bài toán mẫu có thể làm theo cả 2 cách này để em thực hành cho quen, sau đó em sẽ vận dụng sang bài này)

---------------
.Resize(2, 1).EntireRow.Insert tại sao không có vế phải (=xlDown chẳng hạn) thì làm sao hiểu được kết quả dòng được chèn sẽ lên trên hay xuống dưới nhỉ? Hay là theo mặc định các dòng được chèn mới sẽ nằm ở trên ah?

 

[ptm0412]

---------------
.Resize(2, 1).EntireRow.Insert tại sao không có vế phải (=xlDown chẳng hạn) thì làm sao hiểu được kết quả dòng được chèn sẽ lên trên hay xuống dưới nhỉ? Hay là theo mặc định các dòng được chèn mới sẽ nằm ở trên ah?

Bạn thử record macro quá trình insert row xem có bao giờ xuất hiện xlDown hay cái gì khác hay không? Rồi thử insert Column?
Và không cần record macro, thử insert cell, trên hộp thoại hiện ra có cái Up nào không? Chả lẽ bạn chưa bao giờ insert cell, hoặc chưa bao giờ ngó cái hộp thoại insert xem nó có cái gì ở trên?

Tôi nghĩ những chuyện đơn giản này tự mình thử và tìm ra câu trả lời vẫn được, mà lại còn nhớ dai nữa.

Trong số những người gọi tôi là thầy, có 1 người tôi chỉ toàn mắng. Bởi vì tôi biết đối với người này, bị mắng sẽ nhớ dai hơn. Còn bạn?

 

[hoamattroicoi]

Một ví dụ nhỏ về chèn dòng

Cái khó theo em là khi chuyển sang Do Loop While bản thân Loop While nó bị ràng buộc 2 điều kiện: Cells(i, 1).Value "" và i, nên em không biết phải viết thế nào. (Em làm từ sáng không được, em xin mọi người giới thiệu giúp em một bài toán mẫu có thể làm theo cả 2 cách này để em thực hành cho quen, sau đó em sẽ vận dụng sang bài này)

Dùng Do While... Loop

Sub InsertR1()
Dim lRow As Long

Application.ScreenUpdating = False
    lRow = Cells(65536, 2).End(xlUp).Row
    Cells(lRow, 1).Select
    Do While ActiveCell.Row > [A1].End(xlDown).Row
        ActiveCell.End(xlUp).Select
        With ActiveCell
            .Resize(2, 1).EntireRow.Insert
            .Offset(-2, 1).Resize(2, 1).Value = Cells(1, 4).Resize(2).Value
        End With
    Loop
Application.ScreenUpdating = True
End Sub

Dùng vòng FOR :

Sub InsertR2()
Dim i As Long
Dim lRow As Long
Dim fRow As Long
Application.ScreenUpdating = False
fRow = [A1].End(xlDown).Row
lRow = Cells(65536, 2).End(xlUp).Row
    For i = lRow To fRow Step -1
        With Cells(i, 1)
            If .Value <> "" Then
                .Resize(2, 1).EntireRow.Insert
                .Offset(-2, 1).Resize(2, 1).Value = Cells(1, 4).Resize(2).Value
            End If
        End With
    Next
Application.ScreenUpdating = True
End Sub

Dùng Do...Loop Until :

Sub InsertR3()
Dim lRow As Long
Application.ScreenUpdating = False
    lRow = Cells(65536, 2).End(xlUp).Row
    Cells(lRow, 1).Select
    Do
        ActiveCell.End(xlUp).Select
            With ActiveCell
                .Resize(2, 1).EntireRow.Insert
                .Offset(-2, 1).Resize(2, 1).Value = Cells(1, 4).Resize(2).Value
            End With
    Loop Until ActiveCell.Row = [A1].End(xlDown).Row - 2
Application.ScreenUpdating = True
End Sub

Test lại với Sub DeleteR :

Sub deleteR()
Dim fRow As Long
Application.ScreenUpdating = False
    fRow = Cells(1, 2).End(xlDown).Row
    Cells(fRow, 1).End(xlUp).Select
        Do
            ActiveCell.End(xlDown).Select
            ActiveCell.Offset(-2).Resize(2).EntireRow.Delete
        Loop Until ActiveCell.Row = [A65536].End(xlUp).Row + 2
Application.ScreenUpdating = True
End Sub

hoamattroicoi viết đơn giản thế này thôi, cũng bằng những kiến thức mà hoamattroicoi học được, CODE viết còn non nớt, hy vọng nó có ích cho bạn. Chúc bạn học tốt ! Xem xong cái này thì quay lại xử cái kia nhé!

 

[ptm0412]

Do While chỉ cần vầy:

Do While ActiveCell.Row > [A1].End(xlDown).Row

Do ... Loop Until chỉ cần vầy:

   Loop Until ActiveCell.Row <= [A1].End(xlDown).Row

Khỏi -2

 

[TrungChinhs]

Thêm kiểu "cây nhà lá vườn" để bạn tham khảo. Muốn thêm, bớt khoản chi phí nào thì bạn vào cột C của Sheet Chi phi để sửa. Có chỗ nào tếu thì thông cảm nha ! (mất ngủ vọc chơi thôi)

Sub ThemChiPhi()
    Application.ScreenUpdating = False
    On Error Resume Next
    ChiPhi = Sheets("Chi phi").[c:c].SpecialCells(2).Address
    For Each cls In Range("a5:a" & [c65000].End(3).Row)
        If cls > 0 And cls(0, 5) > 0 Then
            cls.Resize(Range(ChiPhi).Rows.Count).EntireRow.Insert
            Sheets("Chi phi").Range(ChiPhi).Copy cls(-Range(ChiPhi).Rows.Count + 1, 3)
        End If
    Next
    If [c65000].End(3)(1, 3) > 0 Then Sheets("Chi phi").Range(ChiPhi).Copy [c65000].End(3)(2)
End Sub

 

[ChanhTQ@]

Còn đây là do không nướng được & xin nhờ các bạn dịch giúp sang tiếng Việt có dấu!

Option Explicit
Sub gpeAdd2RowsForNum()
 Dim Rng As Range, Cls As Range
 
 Set Rng = Columns("A:A").SpecialCells(xlCellTypeConstants, 1)
 For Each Cls In Rng
   If Cls.Value > 1 Then
      Range(Cls, Cls.Offset(1)).EntireRow.Insert
      Cls.Offset(-2, 2).Value = "Chi phí chung:"
      Cls.Offset(-1, 2).Value = "Thu nh" & [iU2].Value
   End If
 Next Cls
End Sub

 

[Dauthivan]

Bạn thử record macro quá trình insert row xem có bao giờ xuất hiện xlDown hay cái gì khác hay không? Rồi thử insert Column?
Và không cần record macro, thử insert cell, trên hộp thoại hiện ra có cái Up nào không? Chả lẽ bạn chưa bao giờ insert cell, hoặc chưa bao giờ ngó cái hộp thoại insert xem nó có cái gì ở trên?

Tôi nghĩ những chuyện đơn giản này tự mình thử và tìm ra câu trả lời vẫn được, mà lại còn nhớ dai nữa.

Trong số những người gọi tôi là thầy, có 1 người tôi chỉ toàn mắng. Bởi vì tôi biết đối với người này, bị mắng sẽ nhớ dai hơn. Còn bạn?

Em rất mong được thày mắng thật nhiều, có thế em mới tiến bộ được chứ ah.

Cái vụ Insert chẳng là trước kia để chèn dòng em toàn chọn cả dòng sau đó bấm phím tắt (Ctrl và dấu +), em ghi Macro thì em mới thấy có cái này (=xlDown).

Được thày và bác Huuthang-bd chỉ bảo, em đã nhận ra trước tiên phải nắm vững cách dùng những thành phần cơ bản nhất, phải tự mày mò tìm hiểu mới có thể nhớ lâu được. Em vừa ra hiệu sách mua được sách dạy lập trình trong Excel của thày Phan Tự Hướng, em sẽ tự mình đào tạo lại toàn bộ các kiến thức cơ bản mà mình còn lơ mơ thày ah. Sau 1, 2 ngày nữa, nếu vấn đề gì mà sau khi bản thân tự tìm hiểu chưa được, em sẽ xin phép được nhờ mọi người.

 

[ptm0412]

Hic, thêm 1 người xin được nghe mắng, làm như mắng không mệt ấy. Nói vậy thôi, yên tâm, sẽ được nghe mắng nhiều và ngày càng bị mắng nặng hơn.

 

[hoamattroicoi]

Em rất mong được thày mắng thật nhiều, có thế em mới tiến bộ được chứ ah.

Ui za? Phải làm sao để không bị mắng chứ, ai lại thích bị mắng như thế bao giờ, he he!

 

[satthudabac]

Thêm kiểu "cây nhà lá vườn" để bạn tham khảo. Muốn thêm, bớt khoản chi phí nào thì bạn vào cột C của Sheet Chi phi để sửa. Có chỗ nào tếu thì thông cảm nha ! (mất ngủ vọc chơi thôi)

Sub ThemChiPhi()
    Application.ScreenUpdating = False
    On Error Resume Next
    ChiPhi = Sheets("Chi phi").[c:c].SpecialCells(2).Address
    For Each cls In Range("a5:a" & [c65000].End(3).Row)
        If cls > 0 And cls(0, 5) > 0 Then
            cls.Resize(Range(ChiPhi).Rows.Count).EntireRow.Insert
            Sheets("Chi phi").Range(ChiPhi).Copy cls(-Range(ChiPhi).Rows.Count + 1, 3)
        End If
    Next
    If [c65000].End(3)(1, 3) > 0 Then Sheets("Chi phi").Range(ChiPhi).Copy [c65000].End(3)(2)
End Sub

Mình thấy bạn viết rất hay, nhưng nếu ta xóa dòng dòng ở giữa trong 3 dòng thì nó không chèn lại nữa.thanks