tạo Code để tự động Insert dòng có điều kiện với

[pomete]

Bác nào giúp em tạo Code như file đính kèm với.

 

[SA_DQ]

Lần sau thì tự tìm ên đi nha.

http://www.giaiphapexcel.com/forum/archive/index.php/t-39973.html

 

[pomete]

Hic, cái lệnh trong đấy là dùng để copy dòng tương tự. Của mình là tạo ra dòng trống mà. Nếu mình hiểu về code thì đã có thể tự sửa được rùi.

 

[concogia]

Hic, cái lệnh trong đấy là dùng để copy dòng tương tự. Của mình là tạo ra dòng trống mà. Nếu mình hiểu về code thì đã có thể tự sửa được rùi.

Right Click vào Sheet1 ==> ViewCode ==> chép cái này vào

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address = "$C$2" Then
        If Target.Value > 1 Then
            Target.Offset(1).Resize(Target.Value - 1).EntireRow.Insert
        End If
    End If
End Sub

Nhập số ở C2 xem kết quả

 

[pomete]

Cảm ơn bạn. File mình đưa lên chỉ là ví dụ thôi. Toàn bộ cột C2 là có số lượng rồi và đứng liền nhau. Mình cần một Code để chèn lần lượt theo từng dòng một (không phải áp dụng cho mỗi ô C2 mà là toàn từng dòng ở cột C). Bạn xem lại giúp nhé!

 

[concogia]

Cảm ơn bạn. File mình đưa lên chỉ là ví dụ thôi. Toàn bộ cột C2 là có số lượng rồi và đứng liền nhau. Mình cần một Code để chèn lần lượt theo từng dòng một (không phải áp dụng cho mỗi ô C2 mà là toàn từng dòng ở cột C). Bạn xem lại giúp nhé!

"Hổng" hiểu
Bạn thí dụ ngay trong file của bạn đi
Dữ liệu ban đầu như thế này ==> nhập số vào cell này ==> ra kết quả như thế này ( bạn nhập thủ công thử mấy em kết quả nhé)
Hiểu được mới làm được
Thân

 

[pomete]

Bạn xem lại ví dụ ở sheet "Kết quả nhé". Lúc đầu sẽ như ở sheet 1 và kết quả sẽ như sheet 2.
Đấy là ví để dễ hiểu thôi nhé, còn khi làm thì bạn vẫn làm trực tiếp trên sheet 1 nhé!

 

[sealand]

Bạn xem đúng không, Insert vào Sheet Ket qua

 

[pomete]

Cám ơn anh Sealam, đúng như yêu cầu rồi. Anh chỉ sửa lại cho em là phần kết quả sẽ làm trực tiếp trên sheet 1 luôn (sheet 2 chỉ là ví dụ để hình dung kết quả sẽ ntn thôi).

 

[sealand]

Vậy thì đây là file tại sheet gốc

Private Sub CommandButton1_Click()
Dim tam, iR, i
tam = Range("C2", [C65536].End(3))
iR = 3
For i = 1 To UBound(tam, 1)
 If tam(i, 1) > 1 Then
 Rows(iR).Resize(tam(i, 1) - 1).Insert Shift:=xlDown
 iR = iR + tam(i, 1)
 Else
 iR = iR + 1
 End If
Next
End Sub

 

[kydanh.gpexcel]

Bác sealand xem lại hộ cái. Tôi đã làm như hướng dẫn mà không thực hiện được như bác chủ topic nhỉ?

 

[sealand]

Bạn đưa file dở dang của bạn lên xem sao, chứ đoán thật khó.
Nếu hướng dẫn thì bạn phải có cấu trúc sheet tương tự. Nếu khác đi thì phải điều chỉnh code cho phù hợp

Có thể dùng code sau ngắn hơn 1 chút

Private Sub Chen()
Dim Cl As Range
Set Cl = [C65000].End(3)
Do
If Cl.Row < 2 Then Exit Do
If Cl.Value > 1 Then Rows(Cl.Row + 1).Resize(Cl.Value - 1).Insert Shift:=xlDown
Set Cl = Cl.Offset(-1)
Loop
End Sub

 

[kydanh.gpexcel]

Tôi có 01 DS như ở sheet1. Muốn chèn thêm dưới mỗi dòng tên một số lượng dòng trống (ví dụ 24 dòng). Bình thường nếu ít có thể chèn thủ công nhưng DS lên đến 500 người thì rất mất thời gian. Thanks bác.

 

[nmhung49]

Đâu bạn thử chèn đoạn code này thử xem sao mà mình thấy dùng vòng lặp thì tốc độ chậm nếu file có dữ liệu nhiều.

Sub chendong()
Dim i As Long, adrss As Range
For i = 1 To 10000
If Sheet1.Cells(i, 1) <> "" Then
Set adrss = Cells(i, 1)
Rows(adrss.Row + 1 & ":" & adrss.Row + 23).Insert xlDown
End If
Next
End Sub

 

[sealand]

Bạn thử sub này xem sao, mình thử vài ngàn dòng khá nhanh đấy. Mặt khác không chèn dòng nên ít ảnh hưởng cấu trúc bảng

Sub CommandButton1_Click()
Dim Rg As Range, Dg
Dim tam, mg(), i, j
Set Rg = Application.InputBox("Nhap hay chon vung danh sach", , , , , , , 8)
Dg = InputBox("Nhap so dong chen them moi nguoi")
tam = Rg
ReDim mg(Rg.Rows.Count + Rg.Rows.Count * Dg, Rg.Columns.Count)
For i = 1 To Rg.Rows.Count
For j = 1 To Rg.Columns.Count
mg((i - 1) * (Dg + 1), j - 1) = tam(i, j)
Next
Next
Rg.Cells(1).Resize(UBound(mg, 1), Rg.Columns.Count) = mg
End Sub

Mình chưa viết các phhần chống lỗi như chọn vùng không hơp lệ, số dòng chèn vượt 65536 vv

 

[kydanh.gpexcel]

ok. Tôi làm được rồi. Cám ơn bác sealand nhiều. May có bác giúp không thì tối mắt.

 

[nmhung49]

Bạn thử sub này xem sao, mình thử vài ngàn dòng khá nhanh đấy. Mặt khác không chèn dòng nên ít ảnh hưởng cấu trúc bảng

Sub CommandButton1_Click()
Dim Rg As Range, Dg
Dim tam, mg(), i, j
Set Rg = Application.InputBox("Nhap hay chon vung danh sach", , , , , , , 8)
Dg = InputBox("Nhap so dong chen them moi nguoi")
tam = Rg
ReDim mg(Rg.Rows.Count + Rg.Rows.Count * Dg, Rg.Columns.Count)
For i = 1 To Rg.Rows.Count
For j = 1 To Rg.Columns.Count
mg((i - 1) * (Dg + 1), j - 1) = tam(i, j)
Next
Next
Rg.Cells(1).Resize(UBound(mg, 1), Rg.Columns.Count) = mg
End Sub

Mình chưa viết các phhần chống lỗi như chọn vùng không hơp lệ, số dòng chèn vượt 65536 vv

Cảm ơn anh Sealand, em đang học về mảng mà không hiểu cho lắm đoạn code này hay lắm mà em không hiểu cho lắm anh giải thích giúp hen. Thanks

 

[ndu96081631]

Bạn thử sub này xem sao, mình thử vài ngàn dòng khá nhanh đấy. Mặt khác không chèn dòng nên ít ảnh hưởng cấu trúc bảng

Sub CommandButton1_Click()
Dim Rg As Range, Dg
Dim tam, mg(), i, j
Set Rg = Application.InputBox("Nhap hay chon vung danh sach", , , , , , , 8)
Dg = InputBox("Nhap so dong chen them moi nguoi")
tam = Rg
ReDim mg(Rg.Rows.Count + Rg.Rows.Count * Dg, Rg.Columns.Count)
For i = 1 To Rg.Rows.Count
For j = 1 To Rg.Columns.Count
mg((i - 1) * (Dg + 1), j - 1) = tam(i, j)
Next
Next
Rg.Cells(1).Resize(UBound(mg, 1), Rg.Columns.Count) = mg
End Sub

Mình chưa viết các phhần chống lỗi như chọn vùng không hơp lệ, số dòng chèn vượt 65536 vv

Cái này cũng hay. Đương nhiên dùng mảng sẽ cho tốc độ cực cao. Tuy nhiên, sẽ hay hơn nếu anh viết thành 1 Function hoặc Sub có tham số truyền vào thì càng tuyệt! Mai này cứ việc "móc ra" mà dùng
Kiểu vầy:

Function InsertRow(byVal sArray, byVal lRow as Long)

Kết quả của Function trả về sẽ là 1 mảng
Hoặc

sub InsertRow(byVal sArray, byVal lRow as Long, Target as Range)

Thực thi tính toán rồi gán kết quả tại Target