[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『スピードアップさせるには？』（ヒロ）
以下のマクロですが時間が掛かります。約1〜2分
スピードアップ可能でしょうか？
よろしくお願いします。
データはだいたい 2000〜3500行(件名により違いますが)あります。
Sub ゼロ消去()
Dim i As Long
For i = 2 To Cells(Rows.Count, "A").End(xlUp).Row
If Cells(i, 1).Value = "" Or Cells(i, 1).Value = 0 Then Cells(i, 1).Resize(, 2).ClearContents
Next
End Sub
＜ 使用 Excel：Excel2016、使用 OS：Windows10 ＞
＞約1〜2分
は、異常なので、計算方法を、一時的に手動にするだけで解決するかもしれません。
（マナ） 2020/03/22(日) 16:46
横から失礼します。
試してないので考え方だけ。
A2〜A列の最終行まで選択 ↓ 置換で「セル内容が完全に同一であるものを検索する」にチェックを入れ 検索する文字列「0」 置換後の文字列をブランク(何も入れない) で置換
A2〜A列の最終行まで選択したままで ジャンプ ↓ 「条件を選択してジャンプ」で「空白」を指定して ブランクセルを選択
その選択したｾﾙに対してループ処理で列方向にResize(,2) したｾﾙをクリア （OK） 2020/03/22(日) 16:48
>＞計算方法を、一時的に手動にするだけで解決するかもしれません。 >手動？マクロで、できないものかと
「計算方法」をマクロで手動にすることもできますよ。 マクロの自動記録をしてみてください。
私の提示した方法もマクロを念頭においてます。 ますはマクロの自動記録をしてみてください。 （OK） 2020/03/22(日) 17:02
' Macro2 Macro
Selection.Replace What:="0", Replacement:="", LookAt:=xlWhole, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False, FormulaVersion:=xlReplaceFormula2
Selection.SpecialCells(xlCellTypeBlanks).Select
Selection.ClearContents
Range("C19").Select
マクロ化させる技が乏しく、よくわかりません。
＞その選択したｾﾙに対してループ処理で列方向にResize(,2)
＞したｾﾙをクリア
よろしくお願いします。
（ヒロ） 2020/03/22(日) 17:07
ご提示のコードを変数宣言、ループ組み込みしてみました。
Sub test()
Dim c As Range
Dim rngA As Range
Dim rngB As Range
Set rngA = ActiveSheet.Range(ActiveSheet.Range("A1"), ActiveSheet.Range("A" & Rows.Count).End(xlUp))
rngA.Replace What:="0", Replacement:="", LookAt:=xlWhole, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False ', FormulaVersion:=xlReplaceFormula2 '最後の部分コメントアウトしています。バージョンによるのか、エラーになるので。
Set rngB = rngA.SpecialCells(xlCellTypeBlanks)
For Each c In rngB
c.Resize(, 2).ClearContents
Next c
Set rngA = Nothing
Set rngB = Nothing
End Sub
（OK） 2020/03/22(日) 17:26
>If Cells(i, 1).Value = "" Or Cells(i, 1).Value = 0 Then Cells(i, 1).Resize(, 2).ClearContents
数式の結果が長さ0の文字列の場合や、数式の結果が0の場合もクリアされます。
私が提示したジャンプで空白セルを選択する方法は、セルに何も入力されていないセル のみが対象になります。 （OK） 2020/03/22(日) 17:30
マクロの自動記録でえられたコードです。
Application.Calculation = xlManual 'ブックの計算方法：手動
Application.Calculation = xlAutomatic 'ブックの計算方法：自動
（OK） 2020/03/22(日) 17:38
参考HPです。
セルのValueとValue2とTextとFormulaとFormula2の違い https://vbabeginner.net/%E3%82%BB%E3%83%AB%E3%81%AEvalue%E3%81%A8text%E3%81%AE%E9%81%95%E3%81%84/ （OK） 2020/03/22(日) 17:40
ブランクセルに対して右側2列に拡張してクリア、という ところがネックになります。
ちなみに、↓は一行目でブランクセルを選択しています。 で、2行目で、ブランクセルの内容をクリアしています。 つまり、2行目は無駄なことをしています。
Selection.SpecialCells(xlCellTypeBlanks).Select Selection.ClearContents （OK） 2020/03/22(日) 17:51
>Sub Macro2()
これは、A列のみをクリアしています。
>Sub ゼロ消去()
これは、A列、B列をクリアしています。 （OK） 2020/03/22(日) 17:53
これまた試してないですけど、オートフィルタでセル選択して 選択したｾﾙに対してクリア、とすればループは不要かもしれないです。 （OK） 2020/03/22(日) 18:05
＞ >Sub ゼロ消去()
＞ これは、A列、B列をクリアしています。
そうですか
２列の削除なので、時間が掛かるのでしょうか？
再度取得してみました。
Sub Macro3()
'
' Macro3 Macro
Range("A2:B2225").Select
Range("B2225").Activate
Selection.Replace What:="0", Replacement:="", LookAt:=xlWhole, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False, FormulaVersion:=xlReplaceFormula2
Selection.SpecialCells(xlCellTypeBlanks).Select
Selection.ClearContents
End Sub
（ヒロ） 2020/03/22(日) 18:10
オートフィルタの場合です。
Sub test2()
Dim rng As Range
Set rng = ActiveSheet.Range(ActiveSheet.Range("A1"), ActiveSheet.Range("A" & Rows.Count).End(xlUp))
rng.AutoFilter Field:=1, Criteria1:="=0", Operator:=xlOr, Criteria2:="="
rng.Resize(, 2).ClearContents
Set rng = Nothing
End Sub
（OK） 2020/03/22(日) 18:18
Sub ゼロ消去()
Dim i As Long
Dim 削除するセル As Range
Stop '←ブレークポイントのかわり
For i = 2 To Cells(Rows.Count, "A").End(xlUp).Row
If Cells(i, 1).Value = "" Or Cells(i, 1).Value = 0 Then
If 削除するセル Is Nothing Then
Set 削除するセル = Cells(i, 1).Resize(, 2)
Else
Set 削除するセル = Union(削除するセル, Cells(i, 1).Resize(, 2))
End If
End If
Next i
'▼1回だけクリア
削除するセル.ClearContents
End Sub
（もこな２） 2020/03/22(日) 18:20
削除するセル.ClearContents
↓
If Not 削除するセル Is Nothing Then 削除するセル.ClearContents
（もこな２） 2020/03/22(日) 18:23
A列がブランクか0の場合にA列、B列をクリアする、という ことではないのですか？
Macro3はA2〜B2225の中のブランクセルをクリアしています。 A列がブランクでなくてもB列がクリアしています。
※私はUnionは格納できるセル範囲が30までなので、 ほとんど使ったことがありません。 （OK） 2020/03/22(日) 18:33
（もこな２）さん
ありがとうございます。
＞逐一消去しない
一気にということですね
マクロありがとうございました。
こちらも快速です。
すっきりしました。相談してよかったな〜
（ヒロ） 2020/03/22(日) 18:36
Unionに格納するたびにカウントアップし、30になったら一括でクリア、 Unionの内容をEraseして再度格納を始める、という手もあると思います。 （OK） 2020/03/22(日) 18:38
（ヒロ） 2020/03/23(月) 04:31
（ヒロ） 2020/03/23(月) 12:33
Sub 実験()
Dim i As Long
Dim MyRNG As Range
Set MyRNG = Range("A1")
For i = 3 To 100 Step 2
Set MyRNG = Union(MyRNG, Cells(i, "A"))
Next i
Range("A1").Resize(MyRNG.Areas.Count).Value = _
WorksheetFunction.Transpose(Split(MyRNG.Address(0, 0), ","))
End Sub
ヘルプを見ると
式.Union(Arg1, Arg2, Arg3, Arg4, ... Arg29, Arg30)
ってなっているので、一度に格納できるのは30範囲だとおもいますが、ループ処理をして複数回に分けて格納するのは大丈夫なんじゃないでしょうか？
（もこな２） 2020/03/28(土) 09:36
Unionステートメントの引数の数は30までですが、 結果として Rangeオブジェクトになるわけですが、 Rangeオブジェクトがどれだけの数のArea(離れたセル範囲)を格納できるかはまた別の制限があるはず
記憶が定かではありませんが、昔のバージョンでは8192個までだったような気がします。 最近のバージョンではもっといけると思いますが、無制限ではないと思われます。
あと昔のバージョンは、Unionを繰り返してAreaが増えると実行速度が低下するという現象もありました これも最近のバージョンでは改善されているのかもしれません。
なんとなく「昔のバージョン」と「最近のバージョン」とか書いてますけど、 シートの最大行数と最大列数が増えたのっていつだったなぁっていうくらいの昔です。 （´・ω・`） 2020/03/28(土) 10:05
おはようございます。 全くの横からですけど、、、 最初のスピードUPについて、、早いかどうかは分かりませんが、 要は、、シートに触る回数を減らすことだと私は思っていて、、 このシートに触るにも色々あって、、、 例えば、、シートを保護しておいて、、消したいセルのロックだけ外します。 で、一括でEmptyにすると ロックの外れているセルだけ消えます？？？(多分(^^;昔と仕様がかわっていなければ。。。） この触ると触らないの違いが上手く伝わるといいんですけど、、、
Option Explicit
Sub ゼロ消去()
Dim i As Long
Range("A2", Range("A" & Rows.Count).End(xlUp)).Locked = True
For i = 2 To Cells(Rows.Count, "A").End(xlUp).Row
If Cells(i, 1).Value = "" Or Cells(i, 1).Value = 0 Then
Cells(i, 1).Locked = False
End If
Next
ActiveSheet.Protect
On Error Resume Next
Range("A2", Range("A" & Rows.Count).End(xlUp)).Value = Empty
ActiveSheet.Unprotect
End Sub
（SoulMan） 2020/03/28(土) 10:24
あと、スピードにこだわるのなら↓これは
If Cells(i, 1).Value = "" Or Cells(i, 1).Value = 0 Then
Cells(i, 1).Locked = False
End If
これ↓の方が早いとおもいます。。多分(^^;
If Cells(i, 1).Value = "" Then
If Cells(i, 1).Value = 0 Then
Cells(i, 1).Locked = False
End If
End If
というかぁ、、消すんですから、、
これ↓だけですよね？？？(^^;
If Cells(i, 1).Value = 0 Then
Cells(i, 1).Locked = False
End If
（SoulMan） 2020/03/28(土) 10:31
コメントを踏まえて、↓のようなコードを、（Excel2007、Windows10）で実行したところ
Sub 実験()
Dim i As Long
Dim MyRNG As Range
Set MyRNG = Range("A1")
For i = 3 To 5000 Step 2
Set MyRNG = Union(MyRNG, Cells(i, "A"))
Debug.Print MyRNG.Areas.Count
Next i
End Sub
範囲の数が1750前後（1739,1731,1774,1757,1754)を超えたあたりでフリーズしたかとおもうくらいに時間がかかるようになりました。
したがって、Excel2007では「Unionを繰り返してAreaが増えると実行速度が低下する」は発生しちゃうようですね。
（時間がかかってしょうがないので、格納限界には挑戦せず・・）
（もこな２） 2020/03/28(土) 11:12
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.