Nhờ mọi người viết hộ cod chèn dòng

[trungboss0608]

Cần sự giúp đỡ

 

[SA_DQ]

Bạn đến đây tham khảo nè: http://www.danketoan.com/threads/cac-cach-them-dong-moi-vo-1-csdl-co-so-du-lieu-da-san.182915/

 

[Quang_Hải]

Cần sự giúp đỡ

Code của bạn đây. Dám chắc đây chỉ là ý tưởng. Code đúng chắc còn xa xôi vì file mẫu quá tạm bợ

Sub Chen_Dong()
Dim sArr(), i As Long, Res(1 To 1000, 1 To 5), j As Long, k As Long, n As Long
sArr = [A4:D9].Value
For i = 1 To UBound(sArr)
   k = k + 1
   For j = 1 To 4
      Res(k, j) = sArr(i, j)
   Next
  If sArr(i, 4) > 0 Then
      For n = 1 To sArr(i, 4)
         k = k + 1
         Res(k, 5) = "Chen Them"
      Next
  End If
Next
[A14].Resize(k, 5) = Res
End Sub

 

[trungboss0608]

Code của bạn đây. Dám chắc đây chỉ là ý tưởng. Code đúng chắc còn xa xôi vì file mẫu quá tạm bợ

Sub Chen_Dong()
Dim sArr(), i As Long, Res(1 To 1000, 1 To 5), j As Long, k As Long, n As Long
sArr = [A4:D9].Value
For i = 1 To UBound(sArr)
   k = k + 1
   For j = 1 To 4
      Res(k, j) = sArr(i, j)
   Next
  If sArr(i, 4) > 0 Then
      For n = 1 To sArr(i, 4)
         k = k + 1
         Res(k, 5) = "Chen Them"
      Next
  End If
Next
[A14].Resize(k, 5) = Res
End Sub

Nhờ a xem lại giúp!

 

[SA_DQ]

Sub InsertRowsForNum()
 Dim Rws As Long, J As Long, W As Long, Col As Integer, Dg
 Dim Arr()
 
 With Sheets("De bai")
    Rws = .[B4].CurrentRegion.Rows.Count
    Arr() = .[A4].Resize(Rws, 5).Value
 End With
 Sheets("KQ").[A4].Resize(Rws, 5).Value = ""
 ReDim dArr(1 To 9 * Rws, 1 To 5)
 For J = 1 To UBound(Arr())
    W = W + 1
    For Col = 1 To 5
        dArr(W, Col) = Arr(J, Col)
    Next Col
    If IsNumeric(Arr(J, 5)) Then
        For Dg = 1 To Arr(J, 5)
            W = W + 1:          dArr(W, 2) = UCase$(Arr(J, 2))
        Next Dg
    End If
 Next J
 If W Then
    Sheets("KQ").[A4].Resize(W, 5).Value = dArr()
 End If
End Sub

 

[trungboss0608]

Sub InsertRowsForNum()
Dim Rws As Long, J As Long, W As Long, Col As Integer, Dg
Dim Arr()

With Sheets("De bai")
    Rws = .[B4].CurrentRegion.Rows.Count
    Arr() = .[A4].Resize(Rws, 5).Value
End With
Sheets("KQ").[A4].Resize(Rws, 5).Value = ""
ReDim dArr(1 To 9 * Rws, 1 To 5)
For J = 1 To UBound(Arr())
    W = W + 1
    For Col = 1 To 5
        dArr(W, Col) = Arr(J, Col)
    Next Col
    If IsNumeric(Arr(J, 5)) Then
        For Dg = 1 To Arr(J, 5)
            W = W + 1:          dArr(W, 2) = UCase$(Arr(J, 2))
        Next Dg
    End If
Next J
If W Then
    Sheets("KQ").[A4].Resize(W, 5).Value = dArr()
End If
End Sub

Cảm ơn anh!. chỗ kết quả cho luôn vào sheets De bai. (khi chạy cod được file như file kết quả) chứ không phải thêm sheets KQ

 

[SA_DQ]

Vậy thì bạn tự vô hiệu hóa dòng lệnh này đi, bằng cách nào đó:

 Sheets("KQ").[A4].Resize(Rws, 5).Value = ""

Còn lại bạn phải tự chinh mớ dòng lệnh sau cho đúng vị trí ô trên trang tính chứa dữ liệu thôi:

If W Then
    Sheets("KQ").[A4].Resize(W, 5).Value = dArr()
End If