Board logo

標題: [發問] (已解決)插入一行空白列有快速的方式嗎? [打印本頁]
作者: freeffly    時間: 2012-4-23 15:52     標題: (已解決)插入一行空白列有快速的方式嗎?

本帖最後由 freeffly 於 2012-4-24 15:35 編輯

目前知道的方法有這三種
不過前面兩種速度好像稍微慢
最後一種用輔助欄的方式好像有稍微快一點
不知道還有沒有方式可以讓插入一行速度更快
範例說明：當編號不一樣插入一行區隔
  1.   Sub 插入一行()
  2.     Application.ScreenUpdating = False
  3.     r = 4
  4.     Do While Cells(r, 3) <> ""
  5.     first = Cells(r, 3)
  6.     Do While Cells(r, 3) = first
  7.     r = r + 1
  8.     Loop
  9.     Rows(r).Insert
  10.     r = r + 1
  11.     Loop
  12. End Sub
複製代碼
  1. Sub 插入行()
  2. Application.ScreenUpdating = False
  3. Dim ra As Long
  4. For ra = [A65536].End(xlUp).Row To 3 Step -1  '從最後一行向前建立行迴圈，步進-1
  5. If Range("C" & ra) <> Range("C" & ra - 1) Then
  6. Rows("" & ra).Insert shift:=xlDown    '插入1行
  7. End If
  8. Next
  9. End Sub
複製代碼
  1. Sub 插入()
  2. Application.ScreenUpdating = False
  3. Dim ra As Long
  4. For ra = [A65536].End(xlUp).Row To 3 Step -1  '從最後一行向前建立行迴圈，步進-1
  5. If Range("C" & ra) = "Y" Then
  6. Rows("" & ra).Insert shift:=xlDown    '插入1行
  7. End If
  8. Next
複製代碼
[attach]10608[/attach]
作者: Hsieh    時間: 2012-4-23 16:09

回復 1# freeffly
利用小計功能
  1. Sub Ex()
  2.    With Range("A1").CurrentRegion
  3.     .Subtotal GroupBy:=2, Function:=xlCount, TotalList:=Array(2), _
  4.         Replace:=True, PageBreaks:=False, SummaryBelowData:=True
  5.     .SpecialCells(xlCellTypeFormulas).EntireRow.Clear
  6.      Range("A1").ClearOutline
  7.     End With     
  8. End Sub
複製代碼
作者: freeffly    時間: 2012-4-23 16:10

剛剛是了一下將所有Y選起然後一次插入可以減少時間
可是選取的方式要做到跟ctrl選取一樣
下面是之前我提問別的問題改的
可是用這種方式會做到連續選取
改成插入行就會跟我要的不一樣
  1. Sub di()
  2.     Dim rag As Range, n As Integer
  3.    
  4.     n = 3
  5.     Do Until Cells(n, 2) = ""
  6.     If Cells(n, 3) = "Y" Then
  7.     If rag Is Nothing Then
  8.     Set rag = Cells(n, 3)
  9.     Else
  10.     Set rag = Union(rag, Cells(n, 3))
  11.     End If
  12.     End If
  13.     n = n + 1
  14.     Loop
  15.     rag.Select
  16.    End Sub
複製代碼
作者: freeffly    時間: 2012-4-23 16:20

本帖最後由 freeffly 於 2012-4-23 16:25 編輯

回復 2# Hsieh


    版主你的方法之前沒想過(應該可以算不用程式碼的方法吧)
   不過剛剛跑還是有點久<不過比原來方式快>   
     我自己試錄巨集也要花很多時間(還沒跑完)
    剛剛想的用個別選取然後再一起插入好像是可以比較快達成
   不過個別選取這各程式碼的動作我不知道怎嚜寫
作者: oobird    時間: 2012-4-23 17:14

只要有相鄰列就無法一起選取分別插入的，那會插入在同一區塊
再說判斷插入列是很慢的，最好的方式是重建資料。例如：
  1. Sub 插入()
  2.     Dim rng, arr, i%, r%
  3.     T = Timer
  4.     rng = Range([a1], [b65536].End(3))
  5.     ReDim arr(1 To UBound(rng) * 2, 1 To 2) As String
  6.     For i = 1 To UBound(rng)
  7.         r = r + 1
  8.         If i > 2 Then
  9.             If rng(i, 2) <> arr(r - 1, 2) Then r = r + 1
  10.         End If
  11.         arr(r, 1) = rng(i, 1): arr(r, 2) = rng(i, 2)
  12.     Next
  13.     [a:b] = ""
  14.     [a1].Resize(r, 2) = arr
  15.     MsgBox Timer - T
  16. End Sub
複製代碼
作者: freeffly    時間: 2012-4-23 17:22

回復 5# oobird


    版主好快喔
   雖然程式碼看起來很簡單
   但是我看不太懂
   redim以後的我都看不太懂
   可以大略講一下嗎



歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)