[Hỏi VBA] Tạo các dòng mô tả nhóm hao phí Vật liệu, Nhân công, Máy.

Xin chào anh chị em trong diễn đàn xaydung360.vn !
Hiện tại, tôi đang có một file diễn giải chi tiết các mã hiệu công việc theo định mức 1776 (phục vụ tính chiết tính đơn giá), tuy nhiên file này có nhược điểm là không có các dòng thể hiện nhóm hao phí về Vật liệu (VL), Nhân công (NC), Máy thi công (MTC). Tôi muốn nhờ Anh/Chị/Em tạo một Code VBA để chèn các nhóm hao phí về VL, NC, MTC này vào trong từng công việc (chi tiết xem file mô tả)
Thanks !
File mô tả: Chiet tinh.xlsx (14.18 KB, Lượt tải về: 868)

13/10/2016 12:58 Tải lên

Click to download

Dùng Code này xem:

[Visual Basic] 纯文本查看 复制代码

Sub ChenNhomHaoPhi()
     Dim i As Long, DauCV As Long, CuoiCV As Long
     Dim SoVL As Integer, SoNC As Integer, SoMTC As Integer
     Dim NhomVL As String, NhomNC As String, NhomMTC As String, TenNhom As String
     Dim Rng As Range
     
     NhomVL = "V" & ChrW(7853) & "t li" & ChrW(7879) & "u"
     NhomNC = "Nh" & ChrW(226) & "n c" & ChrW(244) & "ng"
     NhomMTC = "M" & ChrW(225) & "y thi c" & ChrW(244) & "ng"
     SoCV = WorksheetFunction.CountA(Range("A2:A" & Range("A65500").End(xlUp).Row))
     On Error GoTo Handle
     With Application          'Tang toc xu ly
       .Calculation = xlCalculationManual
       .ScreenUpdating = False
       .EnableEvents = False
       .DisplayAlerts = False
       .Cursor = xlWait
       .EnableCancelKey = xlErrorHandler
     End With
     Range("A2").Select
     Do
          DauCV = ActiveCell.Offset(1).Row
          CuoiCV = ActiveCell.End(xlDown).Row - 1
          If CuoiCV > 65500 Then CuoiCV = Range("B65500").End(xlUp).Row
          For Each Rng In Range("B" & DauCV & ":B" & CuoiCV)
               TenNhom = Left$(Rng.FormulaR1C1, 1)
               Select Case TenNhom
               Case "V": SoVL = SoVL + 1
                    If SoVL = 1 Then
                         Rng.EntireRow.Insert
                         With Rng.Offset(-1, 1)
                              .FormulaR1C1 = NhomVL
                              .Font.FontStyle = "Bold Italic"
                              .Font.ColorIndex = 23
                         End With
                    End If
               Case "N": SoNC = SoNC + 1
                    If SoNC = 1 Then
                         Rng.EntireRow.Insert
                         With Rng.Offset(-1, 1)
                              .FormulaR1C1 = NhomNC
                              .Font.FontStyle = "Bold Italic"
                              .Font.ColorIndex = 23
                         End With
                    End If
               Case Else: SoMTC = SoMTC + 1
                    If SoMTC = 1 Then
                         Rng.EntireRow.Insert
                         With Rng.Offset(-1, 1)
                              .FormulaR1C1 = NhomMTC
                              .Font.FontStyle = "Bold Italic"
                              .Font.ColorIndex = 23
                         End With
                    End If
               End Select
          Next
          SoVL = 0: SoNC = 0: SoMTC = 0     'Reset bien
          ActiveCell.End(xlDown).Select
     Loop Until ActiveCell.Row > 65500
     Range("A2").Select
Handle:
    With Application
       .Calculation = xlCalculationAutomatic
       .ScreenUpdating = True
       .EnableEvents = True
       .DisplayAlerts = True
       .Cursor = xlDefault
       .EnableCancelKey = xlInterrupt
    End With
End Sub

tranhoe gửi lúc 14/10/2016 08:51
Dùng Code này xem:
[mw_shl_code=vb,true]Sub ChenNhomHaoPhi()
     Dim i As Long, DauCV As Long, Cu ...

Cảm ơn Chú ạ !
Code chạy theo file ví dụ trên chuẩn rồi ạ. Tuy nhiên cháu đang thực hiện trên file gốc (khoảng 6000 mã hiệu) thì đang treo file. Có vẻ nặng quá, đang ngồi đợi ạ.
Chúc chú sức khỏe !

butua@vn gửi lúc 14/10/2016 12:06
Cảm ơn Chú ạ !
Code chạy theo file ví dụ trên chuẩn rồi ạ. Tuy nhiên cháu đang thực ...

Lần sau nên đánh giá trên bài viết của Anh thì anh mới biết được người hỏi nhé!
Anh hay dùng E2003 nên số dòng tối đa trên bảng tính là 65.536, nếu E2007 thì có 1.048.576 dòng; vì thế đổi số 65500 thành 1.000.000 vẫn được (chỉ chú ý không có dấu phân cách nhóm - tức là 1000000).

Tổng quát nhất nên dùng Cells.Rows.Count.

Sửa code lại như sau (có đưa thêm bẩy lỗi):

[Visual Basic] 纯文本查看 复制代码

Sub ChenNhomHaoPhi()
     Dim i As Long, DauCV As Long, CuoiCV As Long
     Dim SoVL As Integer, SoNC As Integer, SoMTC As Integer
     Dim NhomVL As String, NhomNC As String, NhomMTC As String, TenNhom As String
     Dim Rng As Range
      
     NhomVL = "V" & ChrW(7853) & "t li" & ChrW(7879) & "u"
     NhomNC = "Nh" & ChrW(226) & "n c" & ChrW(244) & "ng"
     NhomMTC = "M" & ChrW(225) & "y thi c" & ChrW(244) & "ng"
     On Error GoTo Handle
     With Application          'Tang toc xu ly
       .Calculation = xlCalculationManual
       .ScreenUpdating = False
       .EnableEvents = False
       .DisplayAlerts = False
       .Cursor = xlWait
       .EnableCancelKey = xlErrorHandler
     End With
     Range("A2").Select
     Do
          DauCV = ActiveCell.Offset(1).Row
          If ActiveCell.End(xlDown).Row < Cells.Rows.Count Then
               CuoiCV = ActiveCell.End(xlDown).Row - 1
          ElseIf ActiveCell.End(xlDown).Row = Cells.Rows.Count And Range("B" & Cells.Rows.Count).FormulaR1C1 <> "" Then
               MsgBox "Da den cuoi bang tinh. Khong the chen them Dong duoc!"
               GoTo Handle
          Else
               CuoiCV = Range("B" & Cells.Rows.Count).End(xlUp).Row
          End If
          For Each Rng In Range("B" & DauCV & ":B" & CuoiCV)
               TenNhom = Left$(Rng.FormulaR1C1, 1)
               Select Case TenNhom
               Case "V": SoVL = SoVL + 1
                    If SoVL = 1 Then
                         Rng.EntireRow.Insert
                         With Rng.Offset(-1, 1)
                              .FormulaR1C1 = NhomVL
                              .Font.FontStyle = "Bold Italic"
                              .Font.ColorIndex = 23
                         End With
                    End If
               Case "N": SoNC = SoNC + 1
                    If SoNC = 1 Then
                         Rng.EntireRow.Insert
                         With Rng.Offset(-1, 1)
                              .FormulaR1C1 = NhomNC
                              .Font.FontStyle = "Bold Italic"
                              .Font.ColorIndex = 23
                         End With
                    End If
               Case Else: SoMTC = SoMTC + 1
                    If SoMTC = 1 Then
                         Rng.EntireRow.Insert
                         With Rng.Offset(-1, 1)
                              .FormulaR1C1 = NhomMTC
                              .Font.FontStyle = "Bold Italic"
                              .Font.ColorIndex = 23
                         End With
                    End If
               End Select
          Next
          SoVL = 0: SoNC = 0: SoMTC = 0     'Reset bien
          ActiveCell.End(xlDown).Select
     Loop Until ActiveCell.Row = Cells.Rows.Count
Handle:
    With Application
       .Calculation = xlCalculationAutomatic
       .ScreenUpdating = True
       .EnableEvents = True
       .DisplayAlerts = True
       .Cursor = xlDefault
       .EnableCancelKey = xlInterrupt
    End With
     Range("A2").Select
End Sub

tranhoe gửi lúc 15/10/2016 14:24
Lần sau nên đánh giá trên bài viết của Anh thì anh mới biết được người hỏi nhé! ...

Chào chú Hòe !Nhờ chú chỉnh sửa cho cháu Code VBA tính chiết tính đơn giá theo file đính kèm dưới đây ạ (trong file đã mô tả rõ ý tưởng, Chú vui lòng Download về và giúp cháu ạ)

[attach]16249[/attach