[發問] (已解決)插入一行空白列有快速的方式嗎?

freeffly

目前知道的方法有這三種
不過前面兩種速度好像稍微慢
最後一種用輔助欄的方式好像有稍微快一點
不知道還有沒有方式可以讓插入一行速度更快
範例說明：當編號不一樣插入一行區隔

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

複製代碼

插入一行.rar (28.46 KB)

下載次數: 12

2012-4-23 15:48

Hsieh

回復 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

剛剛是了一下將所有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

回復 2# Hsieh


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

oobird

只要有相鄰列就無法一起選取分別插入的，那會插入在同一區塊
再說判斷插入列是很慢的，最好的方式是重建資料。例如：

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

回復 5# oobird


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