Em cần giúp đỡ code tạo ra add in tính phân tích khối lượng vật tư hạng mục (1 người xem)

[levelpro]

EM chào các pro em có một vấn đề này mà suuy nghĩ mãi ko lập được mà VBA thì em ko rành đành phải lên diễn đàn nhờ chỉ giáo
Liên quan tới vấn đề tính phân tích vật tư. EM cũng đang tìm cách để phân tích vật tư cho công việc của em được nhanh chóng và em đã tìm và mò vào đc đến đây. Mong anh chỉ giáo em việc này với a.
Chả là em có cái file để phân tích vật tư theo khối lượng của từng đầu việc như trong file
Mà công việc cần làm là tính cả 1 sheet 1000 công tác như thế rất mất thơi gian
Nhờ anh có cách nào điền hết tất cả các mục còn lại với công thức như trong file em đính kèm chỉ với 1 nút bấm ( và trong mỗi ô phải thể hiện công thức tính toán trong ô). E cám ơn anh nhiều rất mong anh giúp đỡ

 

[befaint]

EM chào các pro em có một vấn đề này mà suuy nghĩ mãi ko lập được mà VBA thì em ko rành đành phải lên diễn đàn nhờ chỉ giáo
Liên quan tới vấn đề tính phân tích vật tư. EM cũng đang tìm cách để phân tích vật tư cho công việc của em được nhanh chóng và em đã tìm và mò vào đc đến đây. Mong anh chỉ giáo em việc này với a.
Chả là em có cái file để phân tích vật tư theo khối lượng của từng đầu việc như trong file
Mà công việc cần làm là tính cả 1 sheet 1000 công tác như thế rất mất thơi gian
Nhờ anh có cách nào điền hết tất cả các mục còn lại với công thức như trong file em đính kèm chỉ với 1 nút bấm ( và trong mỗi ô phải thể hiện công thức tính toán trong ô). E cám ơn anh nhiều rất mong anh giúp đỡ

Bạn thử đoạn sau.

Sub DienCT()
Application.ScreenUpdating = False
Dim RR(), i As Long, tmp(), k As Long, lr As Long
lr = Sheet1.Cells(Rows.Count, "C").End(xlUp).Row
tmp = Sheet1.Range("A1:A" & lr).Value
ReDim RR(1 To UBound(tmp, 1))
For i = 3 To UBound(tmp, 1)
    If tmp(i, 1) > 0 Then k = k + 1: RR(k) = i + 1
Next
ReDim Preserve RR(1 To k)
Application.Calculation = xlCalculationManual
For i = 1 To UBound(RR) - 1
    Sheet1.Range("G" & RR(i)).Formula = "=G$" & RR(i) - 1 & "*$E" & RR(i) & "*(1+$F" & RR(i) & ")"
    Sheet1.Range("G" & RR(i)).AutoFill Destination:=Sheet1.Range("G" & RR(i) & ":R" & RR(i)), Type:=xlFillDefault
    Sheet1.Range("G" & RR(i) & ":R" & RR(i)).AutoFill Destination:=Sheet1.Range("G" & RR(i) & ":R" & RR(i + 1) - 2), Type:=xlFillDefault
Next i
    Sheet1.Range("G" & RR(k)).Formula = "=G$" & RR(k) - 1 & "*$E" & RR(k) & "*(1+$F" & RR(k) & ")"
    Sheet1.Range("G" & RR(k)).AutoFill Destination:=Sheet1.Range("G" & RR(k) & ":R" & RR(k)), Type:=xlFillDefault
    Sheet1.Range("G" & RR(k) & ":R" & RR(k)).AutoFill Destination:=Sheet1.Range("G" & RR(k) & ":R" & lr), Type:=xlFillDefault
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub

 

[HieuCD]

EM chào các pro em có một vấn đề này mà suuy nghĩ mãi ko lập được mà VBA thì em ko rành đành phải lên diễn đàn nhờ chỉ giáo
Liên quan tới vấn đề tính phân tích vật tư. EM cũng đang tìm cách để phân tích vật tư cho công việc của em được nhanh chóng và em đã tìm và mò vào đc đến đây. Mong anh chỉ giáo em việc này với a.
Chả là em có cái file để phân tích vật tư theo khối lượng của từng đầu việc như trong file
Mà công việc cần làm là tính cả 1 sheet 1000 công tác như thế rất mất thơi gian
Nhờ anh có cách nào điền hết tất cả các mục còn lại với công thức như trong file em đính kèm chỉ với 1 nút bấm ( và trong mỗi ô phải thể hiện công thức tính toán trong ô). E cám ơn anh nhiều rất mong anh giúp đỡ

bạn chạy code

Sub GPE()
Dim Darr(), FistR As Long,  i As Long
With Sheets("sheet1")
    Darr = .Range("A1:A" & .Range("C65500").End(xlUp).Row + 1).Value
    FistR = 4
    Application.ScreenUpdating = False
    For i = 4 To UBound(Darr)
        If Darr(i, 1) > 0 Or i = UBound(Darr) Then
            .Range("G" & FistR).FormulaR1C1 = "=R" & FistR - 1 & "C*RC5*(1+RC6)"
            .Range("G" & FistR).Copy .Range("G" & FistR & ":R" & i - 1)
            FistR = i + 1
        End If
    Next i
End With
Application.ScreenUpdating = True
End Sub

 

[levelpro]

Anh HIếu CD ơi anh có thể làm giùm em 1 nút TÍNH trong file đính kèm của em để thực thi ko ạ. em cám ơn nhiều

 

[HieuCD]

Anh HIếu CD ơi anh có thể làm giùm em 1 nút TÍNH trong file đính kèm của em để thực thi ko ạ. em cám ơn nhiều

bạn bấm ngôi sao chạy code

 

[levelpro]

dạ em cám ơn anh HIều CD nhiều. Thật hay quá em khâm phục quá. Ngay hôm nay em sẽ đi đăng ký thêm 1 khóa lập trình trên excel để có kiến thức bàn luận với anh em.
ANh cho em hỏi thêm 1 chút nữa đc ko a. giờ em muốn cách làm đó áp dụng cho 1 file thì làm thế nào a.
Em cám ơn anh rất nhiều