Kiểm tra sự tồn tại của một Sheet() và viết công thức SUM trong VBA

[mr.hoang3365]

Mình lang thang trên diễn đàn và đã chỉnh sửa một đoạn code để tra định mức từ Sheet(DM24) và copy vào Sheet(PT) sau đó điền công thức tra đơn giá vào cột Đơn giá và cột Thành tiền. Trong quá trình lập có một số nội dung mình muốn tham khảo ý kiến của các bạn và nhờ các bạn giúp đỡ:
(1) Kiểm tra sự tồn tại của Sh(DM) nếu không tồn tại thì chương trình thông báo để người dùng biết;
(2) Tại cột Đơn giá và Thành tiền trong Sh(PT) mình nhập công thức có code là "=sum(R[1]C[0]:R[j]C[0])" (trường hợp này j thay đổi tùy theo loại định mức) nhưng chương trình báo lỗi. Xin trích một đoạn như sau:
J = 2
If MVT = "VL00#" Then
MHDM.Offset(i, 5).Value = "=sum(R[-1]C[1]:R[-1]C[1])"
'MHDM.Offset(i, 5).Value = "=sum(R[-1]C[j]:R[-1]C[1])" 'Nếu thay C[1] bằng C[j] thì chương trình báo lỗi
MHDM.Offset(i, 6).Value = "=Product(R[0]C[-2],R[0]C[-1])"
ElseIf MVT = "M00#" Then
MHDM.Offset(i, 5).Value = "=sum(R[-1]C[1]:R[-1]C[1])"
MHDM.Offset(i, 6).Value = "=Product(R[0]C[-2],R[0]C[-1])"
ElseIf MVT = "VL000" Then
MHDM.Offset(i, 6).FormulaR1C1 = "=sum(R[1]C[0]:R[1]C[0])"
ElseIf MVT = "M000" Then
MHDM.Offset(i, 6).FormulaR1C1 = "=sum(R[1]C[0]:R[1]C[0])"
Else
MHDM.Offset(i, 5).FormulaR1C1 = "=VLookup(R[0]C[-4],GIA,4, 0)"
MHDM.Offset(i, 6).FormulaR1C1 = "=Product(R[0]C[-2],R[0]C[-1])"
End If
Cụ thể là: Tại các cột thành tiến của mục a. Vật liệu và c. Máy thi công hoặc mục Máy khác (Vật liệu khác) của cột đơn giá có thể có nhiều hàng phải thực hiện công thức Sum khác nhau tùy theo mỗi loại mã hiệu định mức. Mình tìm hiểu mãi mà không tài nào viết được một công thức tổng quát, chit viết được trường hợp số cột và số hàng cố định trong công thức Sum.
Mong các anh chị chỉ giáo thêm!
Xin cảm ơn nhiều!

 

[SA_DQ]

(1) Để kiểm tra sự tồn tại, ta thêm vố đầu macro dòng lệnh sau

Public Sub Worksheet_Change(ByVal MHDM As Range)
 On Error GoTo LoiCT
'. . . . . '

& trước dòng cuối ta lại thêm các dòng sau:

' . . . . . . '
Err_:                   Exit Sub
LoiCT:
    Select Case Err
    Case 9
           'If DM24 Is Nothing Then Exit Sub'
        MsgBox "Sheets Nothing"
    Case Else
        Resume Next
    End Select
End Sub

(2)

MHDM.Offset(i, 5).Value = "=sum(R[-1]C[1]:R[-1]C[1])"
'MHDM.Offset(i, 5).Value = "=sum(R[-1]C[j]:R[-1]C[1])" 'Nếu thay C[1] bằng C[j] thì chương trình báo lỗi

Bạn thử thay bằng:

MHDM.Offset(i, 5).Value = "=sum(R[-1]C[" & J & "]:R[-1]C[1])"

 

[sealand]

Bạn tham khảo Code của mình xem sao:

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
If Target.Column <> 2 Then Exit Sub
If IsEmpty(Target.Value) Then Exit Sub
If Not Ktra("DM24") Then
MsgBox "Khong tim thay Sheet DM24"
Exit Sub
End If
If Not Ktrama(Target.Value) Then
MsgBox "Khong co ma:" & Target.Value
Target.Value = ""
Target.Select
Exit Sub
End If
Dim Cl As Range, Dich As Range, i
Set Dich = Target.Offset(, 1)
Set Cl = Worksheets("DM24").Columns("A").Find(what:=Target.Value)
Dich.Resize(, 4).Value = Cl.Offset(, 1).Resize(, 5).Value
Do While Cl.Offset(1) = ""
Set Cl = Cl.Offset(1)
Set Dich = Dich.Offset(1)
Cl.Offset(, 1).Resize(, 4).Copy Dich
i = i + 1
Loop
If i = 0 Then
Target.Offset(, 5).Formula = "=IF(COUNTIF(Gia!R2C1:R1000C1,RC[-4])>0,VLOOKUP(PT!RC[-4],Gia!R2C1:R1000C4,4,0),0)"
Target.Offset(, 6).Formula = "=RC[-2]*RC[-1]"
Target.Offset(, 1).Resize(, 6).Font.Bold = True
Else
Target.Offset(, 1).Resize(, 6).Font.Bold = True
Target.Offset(, 6).Formula = "=SUM(R[1]C:R[" & i & "]C)"
Target.Offset(1, 5).Resize(i).Formula = "=IF(COUNTIF(Gia!R2C1:R1000C1,RC[-4])>0,VLOOKUP(PT!RC[-4],Gia!R2C1:R1000C4,4,0),0)"
Target.Offset(1, 6).Resize(i).Formula = "=RC[-2]*RC[-1]"
Target.Offset(1, 1).Resize(i, 6).Font.Bold = False
End If
End Sub
'===================================
Function Ktra(Ten As String) As Boolean
Dim Sh As Worksheet
For Each Sh In ThisWorkbook.Sheets
If Sh.Name = Ten Then Ktra = True
Next
End Function
'==================================
Function Ktrama(ByVal Ma) As Boolean
Dim Cl As Range
Set Cl = Worksheets("DM24").Columns("A").Find(what:=Ma)
If Not Cl Is Nothing Then Ktrama = True
Set Cl = Nothing
End Function

Lưu ý trong bảng định mức và bảng giá không để dòng trống (Mình không xem kỹ còn sum các tiểu mục)