Số 5 đó minh họa thôi bạn. Mình chỉ muốn đơn giản từ dòng 1 đến dòng 1000 chẳng hạn. Thì cứ 5 dòng chèn 2 dòng trống
51, 52, 53, 54 đều chứa số '5'.
Ban thử code này coi. Nhớ ấn 1 lần thôi nhé
Sub Insert_Dong()
Dim i&, iR&, jI&
With ActiveSheet
iR = ActiveSheet.Range("A" & Rows.Count).End(3).Row
j = -2
For i = 1 To iR Step 5
j = j + 7
.Rows(j + 1).Insert xlDown, xlFormatFromLeftOrAbove
.Rows(j + 2).Insert xlDown, xlFormatFromLeftOrAbove
Next
End With
End SubOk ok. Haha. Ghi nhận. Em xin ghi nhận
Chỉ tiếp. Nếu muốn không ảnh hưởng công thức, dữ liệu vùng xung quanh. vì sự ảnh hưởng khi ta chèn dòng
Sub test()
Dim i As Long
For i = 10001 To 5 Step -5
Cells(i, 1).Resize(2).Insert xlShiftDown
Next i
End Sub
(1) Chúc mừng bạn nhiều nha!
Code này hơi bị dỏm ở chỗ là for i = 1001 nếu nó là 2000 hay 3000 phải sửa lại à
Con có biết gì đâu. Anh ấy chỉ lại là tốt rồi. Cái nào hay. Thì còn chắt lọc để học cũng được mà chú
Thớt là dân chuyên Xê Cọng Cọng. Cho nên chỉ thích những code gọn nhẹ.
Sub ThemDongTheoYeuCau()
Dim SoDgThem As Byte, KC As Integer, Rws As Long, Col As Integer
Dim J As Long, W As Long, Hg As Integer, Cot As Integer
Rws = [B2].CurrentRegion.Rows.Count
Col = [B2].CurrentRegion.Columns.Count
SoDgThem = InputBox("Sô Dòng Thêm:", "GPE.COM", 3)
KC = InputBox("Khoang Cách Dòng:", "GPE.COM", 7)
If SoDgThem < 3 Or SoDgThem > 6 Then SoDgThem = 3
If KC < 7 Or KC > 9 Then KC = 7
ReDim Arr(1 To 9 * Rws, 1 To Col)
For J = 2 To Rws Step KC
For Hg = 1 To KC
W = W + 1
For Cot = 1 To Col
Arr(W, Cot) = Cells(J + Hg - 1, Cot).Value
Next Cot
Next Hg
W = W + SoDgThem
Next J
Cells(2, Col + 2).Resize(W, Col).Value = Arr()
End SubHơi ngạo nghễ nha em. trình độ còn Non và xanh lắm em trai. Ví dụ dữ liệu như thế này thì cứ 5 dòng cách 2 dòng có được không? Cần tìm kiểu kỳ trước khi phát biểu nha em.
Em biết lỗi rồi, em chỉ là hạt cát trong sa mạc, giọt nước giữa đại dương mênh mông thôi........Xin kính cẩn nghiêng mình đứng nép 1 bên để lắng nghe và học hỏi.
Nick VetBikini đó đã bị Bank Nick 1 tháng rồi. Vì tội Hỗn láo với nhiều thành viên. bạn không nên trách nick đó làm gì. Riêng mình thì bài viết của Thành viên VetBikini mình coi như rác đổ đi. Nên không bao giờ quan tâm câu trả lời của thành viên này
Đói với dân đòi lấy tiền 200 đô Mỹ một tiết dạy Xê Cọng Cọng thì bạn nghĩ là bạn có thể học phơ-ri à?
Thành viên đã từng bị ban Nick 1 tháng vì tội hỗn Láo. Già rồi mà Láo. Bị ban nick 1 tháng chưa chừa cái tật nói nhiều à.
Bạn thử code này nhé!
Function InsertBlankRows(SourceRange As Range, EachRows As Integer, NumAddBlankRows As Integer) As Variant
'SourceRange: Vung du lieu goc
'EachRows: Tan suat thuc hien chen dong trang
'NumAddBlankRows: So dong trang chen them tung lan
Dim sArr(), Res()
Dim I As Long, K As Long, J As Long
'Kiem tra bao dam Vung du lieu goc chi co 1 cot
If SourceRange.Columns.Count > 1 Then Exit Function
'Kiem tra bao dam cac dieu kien la so nguyen lon hon 0
If EachRows < 1 Or NumAddBlankRows < 1 Then Exit Function
'Gan Vung du lieu goc sang mang
sArr() = SourceRange
'Xac dinh kich thuoc mang ket qua
ReDim Res(1 To UBound(sArr, 1) + Int(UBound(sArr, 1) / EachRows) * NumAddBlankRows, 1 To 1)
'Chay vong lap qua tung phan tu cua Mang du lieu goc
For I = 1 To UBound(sArr, 1)
K = K + 1
Res(K, 1) = sArr(I, 1)
'Truong hop chi so cua phan tu chia het cho Tan suat dong
If I Mod EachRows = 0 Then
K = K + NumAddBlankRows
End If
Next I
InsertBlankRows = Res
End FunctionCách tính số dòng của bạn nhiều dòng quá.
| Ngày | Doanh Thu | Ngày | Doanh Thu | ||||||||||||||
3/13/2021 | 80 | 3/13/2021 | 80 | ||||||||||||||
3/13/2021 | 75 | 3/13/2021 | 75 | ||||||||||||||
3/13/2021 | 90.5 | |==>> | 3/13/2021 | 90.5 | |||||||||||||
3/13/2021 | 102 | Tổng | 245.5 | ||||||||||||||
3/14/2021 | 79.6 | ||||||||||||||||
3/14/2021 | 84.7 | |==>> | 3/14/2021 | 79.6 | |||||||||||||
3/15/2021 | 101.2 | 3/14/2021 | 84.7 | ||||||||||||||
3/15/2021 | 94.5 | Tổng | 164.3 | ||||||||||||||
3/15/2021 | 79.5 | |==>> | |||||||||||||||
3/15/2021 | 101.2 | ||||||||||||||||
3/15/2021 | 94.5 | ||||||||||||||||
| |==>> | 3/15/2021 | 79.5 | |||||||||||||||
| Tổng | 275.2 | ||||||||||||||||
| Tổng công: | 685 |
Em cám ơn bác chỉ ra điểm thiếu sót.
Function InsertBlankRows(SourceRange As Range, EachRows As Integer, NumAddBlankRows As Integer) As Variant
'SourceRange: Vung du lieu goc
'EachRows: Tan suat thuc hien chen dong trang
'NumAddBlankRows: So dong trang chen them tung lan
Dim sArr(), Res()
Dim I As Long, K As Long, J As Long
'Kiem tra bao dam cac dieu kien la so nguyen lon hon 0
If EachRows < 1 Or NumAddBlankRows < 1 Then Exit Function
'Gan Vung du lieu goc sang mang
sArr() = SourceRange
'Xac dinh kich thuoc mang ket qua
ReDim Res(1 To UBound(sArr, 1) + Int(UBound(sArr, 1) / EachRows) * NumAddBlankRows, 1 To UBound(sArr, 2))
'Chay vong lap qua tung phan tu cua Mang du lieu goc
For I = 1 To UBound(sArr, 1)
K = K + 1
For J = 1 To UBound(sArr, 2)
Res(K, J) = sArr(I, J)
Next J
'Truong hop chi so cua phan tu chia het cho Tan suat dong
If I Mod EachRows = 0 Then
K = K + NumAddBlankRows
End If
Next I
InsertBlankRows = Res
End FunctionEm cám ơn bác ạ.
Hay nhỉ bác nhiều cái rút gọn được nhiều công đoạn tính số vòng lặp mà giờ em mới biết là số thứ tự bị lẻ trong mảng nó tự làm tròn.Mà em không hiểu sao nó lại như thế này là sao nhỉ bác.
Vì chỉ số của mảng phải là số nguyên cho nên nếu biểu thức tính chỉ số ở dạng số thập phân thì VBA tự ép kiểu thành số nguyên.
