matran25251325
Thành viên tiêu biểu

- Tham gia
- 13/1/11
- Bài viết
- 424
- Được thích
- 39
Theo code thì sẽ xóa các giá trị trong 1 vùng. Vậy giờ có thể cố định 1 hàng nào đó trong vùng ( ví dụ khóa hàng A30) nhưng có thể tính hàm sum đươc ở cột đó thì phải sửa code như thế nào?Nếu dùng protect sheet thì không insert được dòng.
Sub CPXD()
Application.Calculation = xlCalculationManual
Dim sArr(), dArr(), Arr(), I As Long, K As Long, J As Long
Arr = Sheets("GIA TRI DT CP XD").[A9:L9].FormulaR1C1
With Sheets("TLuong DT")
sArr = .Range(.[A9], .[A65000].End(xlUp)).Resize(, 4).Value
End With
ReDim dArr(1 To UBound(sArr, 1), 1 To 12)
For I = 1 To UBound(sArr, 1)
If sArr(I, 1) <> "" Then
K = K + 1
For J = 1 To 4
dArr(K, J) = sArr(I, J)
Next J
If sArr(I, 3) <> "" Then
For J = 5 To 12
dArr(K, J) = Arr(1, J)
Next J
End If
End If
Next I
With Sheets("GIA TRI DT CP XD")
.[A10:L1000].ClearContents
If K Then
.[A10].Resize(K, 12).Value = dArr
.[A10].Resize(K, 12).Value = .[A10].Resize(K, 12).Value ' Bo Cong thuc
End If
End With
Application.Calculation = xlCalculationAutomatic
End Sub
Sub CPXD()
Application.Calculation = xlCalculationManual
Dim sArr(), dArr(), Arr(), I As Long, K As Long, J As Long
Arr = Sheets("GIA TRI DT CP XD").[A9:L9].FormulaR1C1
With Sheets("TLuong DT")
sArr = .Range(.[A9], .[A65000].End(xlUp)).Resize(, 4).Value
End With
ReDim dArr(1 To UBound(sArr, 1), 1 To 12)
For I = 1 To UBound(sArr, 1)
If sArr(I, 1) <> "" Then
K = K + 1
For J = 1 To 4
dArr(K, J) = sArr(I, J)
Next J
If sArr(I, 3) <> "" Then
For J = 5 To 12
dArr(K, J) = Arr(1, J)
Next J
End If
End If
Next I
With Sheets("GIA TRI DT CP XD")
.[A10:L1000].ClearContents
If K Then
.[A10].Resize(K, 12).Value = dArr
.[A10].Resize(K, 12).Value = .[A10].Resize(K, 12).Value ' Bo Cong thuc
End If
End With
Application.Calculation = xlCalculationAutomatic
End Sub