返回列表 上一主題 發帖

[發問] 如何加插行數

[發問] 如何加插行數

附件中,G至J欄,當K欄(間距)的絕對值小於儲存格M4及大於儲存格L4,都自動向下加插行數,將每行間距(J欄)都變為以M4中的設定,間距會是遞增或遞減
綠色部分是用人手加插,請教大大,VBA如何寫才可做到這效果,謝謝!

TEST1.rar (388.53 KB)

用這個會更好,希望各版大,先進們可指教,謝謝!

TEST2.rar (389.07 KB)

TOP

本帖最後由 donod 於 2019-7-8 13:31 編輯

找了關於"插入"的文章,以下還是達不到效果,因為要處理數據很多,無法人手處理,希望大大出手相助,再謝謝!

謝謝GBKEE版大的提供
http://forum.twbts.com/viewthrea ... ighlight=%B4%A1%A4J
工作表上的預設事件(儲存格有改變所觸動事件)
  1. Option Explicit
  2. Private Sub Worksheet_Change(ByVal Target As Range)
  3.     Dim Rng As Range
  4.     Set Rng = Range("C45:H50")   '指定插入新的一列的範圍
  5.    
  6.     If Target.Columns.Count = Rng.Columns.Count Then
  7.         'Columns.Count:傳回範圍內欄位的總數
  8.         'Rows.Count:傳回範圍內列位的總數
  9.         If Not Intersect(Rng, Target) Is Nothing And Target.Rows.Count = 1 Then
  10.         'Intersect 方法 傳回  ***[Range 物件]***,此物件代表兩個或多個範圍重疊的矩形範圍。
  11.         ' Target.Rows.Count = 1  '一列的範圍
  12.             If Target.Cells(1).Column = Rng.Cells(1).Column And Target.Cells(Target.Cells.Count).Column = Rng.Cells(Rng.Cells.Count).Column Then
  13.                 'Target.Cells(1).Column = Rng.Cells(1).Column
  14.                 '插入新的一列的第一個欄號=指定插入新的一列的範圍的第一個欄號
  15.                 'Target.Cells(Target.Cells.Count).Column = Rng.Cells(Rng.Cells.Count).Column
  16.                 '插入新的一列的最後一個欄號 = 指定插入新的一列的範圍的最後一個欄號
  17.                 MsgBox Target.Address
  18.             End If
  19.         End If
  20.     End If
  21. End Sub
複製代碼
http://forum.twbts.com/viewthread.php?tid=21219&highlight=%B4%A1%A4J
  1. Option Explicit
  2. Sub Ex()
  3.     Dim A As Range, B As Variant, i As Integer
  4.     For Each A In Range("A1", Range("A1").End(xlDown))  'A1 往下到最後一筆資料
  5.         B = ""
  6.         For i = 1 To Len(A)
  7.             If Mid(A, i, 1) Like "[A-Z]" Then B = IIf(B = "", Mid(A, i, 1), B & "," & Mid(A, i, 1))
  8.             '找到大寫的字母 導入變數
  9.         Next
  10.         If B <> "" Then        '有找到大寫的字母
  11.             B = Split(B, ",")  '找到大寫字母的陣列
  12.             For i = 0 To UBound(B)
  13.                 A = Replace(A, B(i), " " & B(i))  '加入空格
  14.             Next
  15.             Do While InStr(A, Space(2))         '包含有兩格的空白字元
  16.                 A = Replace(A, Space(2), Space(1))  '消除 兩格的空白字元 為一格的空白字元
  17.             Loop
  18.         End If
  19.     Next
  20. End Sub
複製代碼

TOP

還未成功,再請各位大大相助,再謝謝!

TOP

請問大大這個如何修改,才可做到要求。謝謝!
  1. Private Sub Command173_Click()
  2. Dim x3 As Integer
  3. x3 = [A65536].End(xlUp).Row
  4. For I = 1 To x3
  5. Do While I1 < 12
  6. Rows(I + 1 + i2).Insert
  7. I1 = I1 + 1
  8. Loop
  9. i2 = i2 + I1
  10. I1 = 0
  11. Next
  12. End Sub
複製代碼

TOP

G至J欄,當K欄(間距)的絕對值小於儲存格M4及大於儲存格L4,都自動向下加插行數,將每行間距(J欄)都變為以N4中的設定,間距會是遞增或遞減
綠色部分是用人手加插,請教大大,VBA如何寫才可做到這效果,謝謝!

TOP

再找了這個參考
http://forum.twbts.com/thread-6131-1-1.html
  1. Sub FF()
  2. LastR = [A65536].End(xlUp).Row
  3. For R = LastR To 1 Step -1
  4.   If Cells(R, 1) Like "po*" Then
  5.      Cells(R + 1, 1).Insert Shift:=xlDown
  6.      Cells(R, 2).Copy Cells(R + 1, 1)
  7.   End If
  8. Next R
  9. [B:B] = ""
  10. End Sub
複製代碼

TOP

復制並插入特定的行
https://www.extendoffice.com/zh-TW/documents/excel/3682-excel-copy-and-insert-row-multiple-times.html
  1. Sub test()
  2. 'Updateby Extendoffice 20160616
  3.     Dim xCount As Integer
  4. LableNumber:
  5.     xCount = Application.InputBox("Number of Rows", "Kutools for Excel", , , , , , 1)
  6.     If xCount < 1 Then
  7.         MsgBox "the entered number of rows is error, please enter again", vbInformation, "Kutools for Excel"
  8.         GoTo LableNumber
  9.     End If
  10.     ActiveCell.EntireRow.Copy
  11.     Range(ActiveCell.Offset(1, 0), ActiveCell.Offset(xCount, 0)).EntireRow.Insert Shift:=xlDown
  12.     Application.CutCopyMode = False
  13. End Sub
複製代碼

TOP

網上找到這個
https://blog.51cto.com/hoenix/461350
"要把不连续的时段补充连续"
  1. Sub Macro1()
  2. For i = 2 To 5000 Step 1
  3. If Cells(i, 2) + 2 = Cells(i + 1, 2) Then  //cell(a,b) a为行,b为列
  4. Rows(i + 1).Insert
  5. Cells(i + 1, 2) = Cells(i, 2) + 1
  6. End If
  7. Next i
  8. End Sub
複製代碼

TOP

小輩才疏學淺,以上多個參考如何整合,希望先進們幫助,謝謝!

TOP

        靜思自在 : 一句溫暖的話,就像往別人身上灑香水,自己會沾到兩三滴。
返回列表 上一主題