Giúp đỡ về code chèn thêm hàng kèm theo các thuộc tính

[kawaicandy]

Tình hình là mình đang xây dựng 1 bảng tính và mình muốn thêm tính năng chèn thêm hàng vào thì lại không biết về VBA. Qua tìm hiều trên diễn đàn cộng thêm record macro thì mình cũng đã làm được 1 đoạn code tuy nhiên thao tác thì lại gặp 1 số vấn đề sau:

1. Chỉ chèn thêm được 1 dòng, vì > 1 thì bảng tính bị sai (1 dòng = 2 row excel)
2. Tại cột STT: khi chèn dòng đầu tiên thì STT là 4, chèn dòng tiếp theo nó vẫn lấy là 4 (=B12+1) vì ở đây hàng chèn thêm vào mặc định là sau row 13.
3. Vì như đã nói ở trên, một số đoạn code mình tìm hiểu trên diễn đàn và một số đoạn do record nên có phần hơi lung tung.
Cuối cùng chúc mọi người sức khoẻ để có thể giúp mình tháo gỡ một số khúc mắc ở trên.
Cảm ơn.

 

[sealand]

Mình tham gia code như sau:
-Tự tạo công thức nếu chưa có dòng nào.
-Bỏ dấu ... ô cuối vì để nó chênh vênh dễ sai sót.
-Khi xoá không xoá hết 2 dòng chân (Như bạn đã chèn để giữ định dạng)

Sub Chendong()
Dim eR, eRadd, i, j As Integer
eRadd = InputBox("So Dong muon Chen them:", "Tinh toan duong day")
If eRadd > 0 Then
For i = 1 To eRadd
eR = [B65000].End(xlUp).Row
Rows(eR + 2).Insert: Rows(eR + 2).Insert
Cells(eR + 2, 2).Resize(2).Merge
Cells(eR + 2, 5).Resize(2).Merge
Cells(eR + 2, 8).Resize(2).Merge
Cells(eR + 2, 9).Resize(2).Merge
If IsNumeric(Cells(eR, 2)) Then Cells(eR + 2, 2).FormulaR1C1 = "=R[-2]C+1" Else Cells(eR + 2, 2) = 1
Cells(eR + 2, 10).Formula = "=IF(" & Cells(eR + 2, 5).Address & "=0," & Chr(34) & Chr(34) & "," & Chr(34) & ChrW(963) & " (daN/mm2)" & Chr(34) & ")"
Cells(eR + 3, 10).Formula = "=IF(" & Cells(eR + 2, 5).Address & "=0," & Chr(34) & Chr(34) & "," & Chr(34) & " f(m)" & Chr(34) & ")"
For j = 1 To 6
Cells(eR + 2, j + 10).Formula = "=VLOOKUP(" & Cells(eR + 2, 2).Address & ",Bangtra!$A$3:$O$14," & 2 + j * 2 & ",0)"
Cells(eR + 3, j + 10).Formula = "=VLOOKUP(" & Cells(eR + 2, 2).Address & ",Bangtra!$A$3:$O$14," & 3 + j * 2 & ",0)"
Next
Next
End If
End Sub

 

[sealand]

Chiều nay vội qua nên Code còn dở dang, nay xin điều chỉnh lại (Khi xoá dòng có thể xoá hết vùng chèn):

Sub Chendong()
Dim eR, eRadd, i, j As Integer
eRadd = InputBox("So Dong muon Chen them:", "Tinh toan duong day")
If eRadd > 0 Then
Application.ScreenUpdating = False
For i = 1 To eRadd
eR = [B65000].End(xlUp).Row
If eR < 8 Then eR = 6
Rows(eR + 2).Insert: Rows(eR + 2).Insert
Cells(eR + 2, 2).Resize(2).Merge
Cells(eR + 2, 5).Resize(2).Merge
Cells(eR + 2, 8).Resize(2).Merge
Cells(eR + 2, 9).Resize(2).Merge
If eR > 6 Then
Range(Cells(8, 3), Cells(eR + 3, 3)).Merge
Range(Cells(8, 4), Cells(eR + 3, 4)).Merge
Range(Cells(8, 6), Cells(eR + 3, 6)).Merge
Range(Cells(8, 7), Cells(eR + 3, 7)).Merge
End If
Range(Cells(8, 2), Cells(eR + 3, 16)).Font.Bold = False
Range(Cells(8, 2), Cells(eR + 3, 16)).Borders.Weight = xlThin
If IsNumeric(Cells(eR, 2)) Then Cells(eR + 2, 2).FormulaR1C1 = "=R[-2]C+1" Else Cells(eR + 2, 2) = 1
Cells(eR + 2, 5).Formula = "=VLOOKUP(" & Cells(eR + 2, 2).Address & ",Bangtra!$A$3:$O$14,3,0)"
Cells(eR + 2, 8).Formula = "=VLOOKUP(" & Cells(eR + 2, 2).Address & ",Bangtra!$A$3:$O$14,2,0)"
Cells(eR + 2, 10).Formula = "=IF(" & Cells(eR + 2, 5).Address & "=0," & Chr(34) & Chr(34) & "," & Chr(34) & ChrW(963) & " (daN/mm2)" & Chr(34) & ")"
Cells(eR + 3, 10).Formula = "=IF(" & Cells(eR + 2, 5).Address & "=0," & Chr(34) & Chr(34) & "," & Chr(34) & " f(m)" & Chr(34) & ")"
For j = 1 To 6
Cells(eR + 2, j + 10).Formula = "=VLOOKUP(" & Cells(eR + 2, 2).Address & ",Bangtra!$A$3:$O$14," & 2 + j * 2 & ",0)"
Cells(eR + 3, j + 10).Formula = "=VLOOKUP(" & Cells(eR + 2, 2).Address & ",Bangtra!$A$3:$O$14," & 3 + j * 2 & ",0)"
Next
Next
End If
End Sub

 

[kawaicandy]

Tuyệt thật đấy, code của bạn nhỏ gọn nhưng hội đủ những yêu cầu của mình và chạy rất nhanh hơn cái code cùi bắp của mình học lóm. Cảm ơn bạn nhìu, mình sẽ áp dụng vào trong bảng tính của mình, có j ko hiểu mình xin bạn chỉ giáo thêm.
Cảm ơn

 

[kawaicandy]

Mình muốn hỏi thêm điều này nữa

Cells(eR + 2, j + 10).Formula = "=VLOOKUP(" & Cells(eR + 2, 2).Address & ",BANGTINH!$A$4:$FR$14," & 45 + j * 9 & ",0)"
Cells(eR + 3, j + 10).Formula = "=VLOOKUP(" & Cells(eR + 2, 2).Address & ",BANGTINH!$A$4:$FR$14," & 46 + j * 9 & ",0)"

Nếu mình muốn định dạng 2 chữ số thập phân ở công thức đầu và 4 chữ số thập phân ở công thức sau thì phải làm thêm j hả bạn.
Cuối cùng là do bảng tính của mình công thức rất nhiều nên mình ko muốn 1 ngày đẹp trời lỡ tay xoá đi 1 công thức nào đó mà mình không biết nên đành phải protect sheet. Vậy có cách nào vẫn protect sheet mà vẫn xài được code này ko bạn.
Cảm ơn

 

[sealand]

Bạn sửa Code như sau:

Sub Chendong()
Dim eR, eRadd, i, j As Integer
eRadd = InputBox("So Dong muon Chen them:", "Tinh toan duong day")
If eRadd > 0 Then
[B][COLOR=#0000cd]Unprotect "12345"[/COLOR][/B]
Application.ScreenUpdating = False
For i = 1 To eRadd
eR = [B65000].End(xlUp).Row
If eR < 8 Then eR = 6
Rows(eR + 2).Insert: Rows(eR + 2).Insert
Cells(eR + 2, 2).Resize(2).Merge
Cells(eR + 2, 5).Resize(2).Merge
Cells(eR + 2, 8).Resize(2).Merge
Cells(eR + 2, 9).Resize(2).Merge
If eR > 6 Then
Range(Cells(8, 3), Cells(eR + 3, 3)).Merge
Range(Cells(8, 4), Cells(eR + 3, 4)).Merge
Range(Cells(8, 6), Cells(eR + 3, 6)).Merge
Range(Cells(8, 7), Cells(eR + 3, 7)).Merge
End If
Range(Cells(8, 2), Cells(eR + 3, 16)).Font.Bold = False
Range(Cells(8, 2), Cells(eR + 3, 16)).Borders.Weight = xlThin
If IsNumeric(Cells(eR, 2)) Then Cells(eR + 2, 2).FormulaR1C1 = "=R[-2]C+1" Else Cells(eR + 2, 2) = 1
Cells(eR + 2, 5).Formula = "=VLOOKUP(" & Cells(eR + 2, 2).Address & ",Bangtra!$A$3:$O$14,3,0)"
Cells(eR + 2, 8).Formula = "=VLOOKUP(" & Cells(eR + 2, 2).Address & ",Bangtra!$A$3:$O$14,2,0)"
Cells(eR + 2, 10).Formula = "=IF(" & Cells(eR + 2, 5).Address & "=0," & Chr(34) & Chr(34) & "," & Chr(34) & ChrW(963) & " (daN/mm2)" & Chr(34) & ")"
Cells(eR + 3, 10).Formula = "=IF(" & Cells(eR + 2, 5).Address & "=0," & Chr(34) & Chr(34) & "," & Chr(34) & " f(m)" & Chr(34) & ")"
For j = 1 To 6
Cells(eR + 2, j + 10).Formula = "=VLOOKUP(" & Cells(eR + 2, 2).Address & ",Bangtra!$A$3:$O$14," & 2 + j * 2 & ",0)"
Cells(eR + 3, j + 10).Formula = "=VLOOKUP(" & Cells(eR + 2, 2).Address & ",Bangtra!$A$3:$O$14," & 3 + j * 2 & ",0)"
Next
[B][COLOR=#ff0000]Cells(eR + 2, 11).Resize(, 6).NumberFormat = "#,##0.00"
Cells(eR + 3, 11).Resize(, 6).NumberFormat = "#,##0.0000"[/COLOR][/B]
Next
[B][COLOR=#0000cd]Protect "12345"[/COLOR][/B]
End If
End Sub

Hai dòng màu xanh là mở Pass chèn dòng xong lại khoá trở lại với pass=12345 (Bạn thay Pass bằng Pass của Sheet cho phù hợp)
Hai dòng màu đỏ là định dạng số theo yêu cầu của bạn.

 

[kawaicandy]

Định dạng số thập phân thì ok rồi, còn protect/unprotect thì do mình để đoạn code trên module chứ ko phải trên sheet nên nó ko hỉu đc. Xử lý vấn đề này làm sao hả bạn.
Cảm ơn

 

[sealand]

Định dạng số thập phân thì ok rồi, còn protect/unprotect thì do mình để đoạn code trên module chứ ko phải trên sheet nên nó ko hỉu đc. Xử lý vấn đề này làm sao hả bạn.
Cảm ơn

Bạn phải chỉ rõ tên sheet. Ví dụ:
Sheet1.Unprotect.... (CodeName của Sheet)
WorkSheets("ABCDEF").Unprotect.... (Tên sheet)

 

[kawaicandy]

Ah!!!! Ngon rồi. Cảm ơn bạn lần nữa. Sáng đến giờ nhồi vào đầu cũng được thêm 1 số kiến thức về VBA, từ chỗ ko biết j thì giờ cũng mường tượng được sơ sơ rồi. Chắc có lẽ đây là cách học về VBA nhanh nhất nhỉ