freeffly

高中生 Rank: 3 Rank: 3

帖子: 586
主題: 123
精華: 0
積分: 763
點名: 0
作業系統: WINDOW7
軟體版本: Office 2003
閱讀權限: 50
性別: 男
註冊時間: 2010-5-16
最後登錄: 2017-3-14

熱烈參與勳章好學求知勳章

1^# 跳轉到 » 倒序看帖

打印

字體大小: tT

發表於 2012-4-23 15:52 | 只看該作者

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

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

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

Sub 插入一行()
Application.ScreenUpdating = False
r = 4
Do While Cells(r, 3) <> ""
first = Cells(r, 3)
Do While Cells(r, 3) = first
r = r + 1
Loop
Rows(r).Insert
r = r + 1
Loop
End Sub

複製代碼

Sub 插入行()
Application.ScreenUpdating = False
Dim ra As Long
For ra = [A65536].End(xlUp).Row To 3 Step -1 '從最後一行向前建立行迴圈，步進-1
If Range("C" & ra) <> Range("C" & ra - 1) Then
Rows("" & ra).Insert shift:=xlDown '插入1行
End If
Next
End Sub

複製代碼

Sub 插入()
Application.ScreenUpdating = False
Dim ra As Long
For ra = [A65536].End(xlUp).Row To 3 Step -1 '從最後一行向前建立行迴圈，步進-1
If Range("C" & ra) = "Y" Then
Rows("" & ra).Insert shift:=xlDown '插入1行
End If
Next

複製代碼

插入一行.rar (28.46 KB)

樓主熱帖

字典兩各字還真難理解

Hsieh

超級版主 Rank: 8 Rank: 8

帖子: 4901
主題: 44
精華: 24
積分: 4916
點名: 267
作業系統: Windows 7
軟體版本: Office 20xx
閱讀權限: 150
性別: 男
來自: 台北
註冊時間: 2010-4-30
最後登錄: 2025-10-31

2024年全勤獎章 2023年全勤獎章 2022虎年全勤獎章 2021牛年全勤獎章 2020鼠年全勤獎章 2019 豬年全勤獎章 2018 狗年全勤獎章 2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱心公益勳章 2011兔年全勤獎章

2^#

發表於 2012-4-23 16:09 | 只看該作者

回復 1# freeffly
利用小計功能

Sub Ex()
With Range("A1").CurrentRegion
.Subtotal GroupBy:=2, Function:=xlCount, TotalList:=Array(2), _
Replace:=True, PageBreaks:=False, SummaryBelowData:=True
.SpecialCells(xlCellTypeFormulas).EntireRow.Clear
Range("A1").ClearOutline
End With
End Sub

複製代碼

學海無涯_不恥下問

TOP

freeffly

高中生 Rank: 3 Rank: 3

帖子: 586
主題: 123
精華: 0
積分: 763
點名: 0
作業系統: WINDOW7
軟體版本: Office 2003
閱讀權限: 50
性別: 男
註冊時間: 2010-5-16
最後登錄: 2017-3-14

熱烈參與勳章好學求知勳章

3^#

發表於 2012-4-23 16:10 | 只看該作者

剛剛是了一下將所有Y選起然後一次插入可以減少時間
可是選取的方式要做到跟ctrl選取一樣
下面是之前我提問別的問題改的
可是用這種方式會做到連續選取
改成插入行就會跟我要的不一樣

Sub di()
Dim rag As Range, n As Integer
n = 3
Do Until Cells(n, 2) = ""
If Cells(n, 3) = "Y" Then
If rag Is Nothing Then
Set rag = Cells(n, 3)
Else
Set rag = Union(rag, Cells(n, 3))
End If
End If
n = n + 1
Loop
rag.Select
End Sub

複製代碼

字典兩各字還真難理解

TOP

freeffly

高中生 Rank: 3 Rank: 3

帖子: 586
主題: 123
精華: 0
積分: 763
點名: 0
作業系統: WINDOW7
軟體版本: Office 2003
閱讀權限: 50
性別: 男
註冊時間: 2010-5-16
最後登錄: 2017-3-14

熱烈參與勳章好學求知勳章

4^#

發表於 2012-4-23 16:20 | 只看該作者

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

回復 2# Hsieh

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

字典兩各字還真難理解

TOP

oobird