自分のお店を開く時の心構えとは? >>

列の削除を自動化する次のマクロをおしえていただきました。
ずっと使っていましたが、異常に処理が遅いのです。
列の数は2370列以上あり、変動します。
行数は1から33行までで、固定しています。
この行数の固定を加味して、もっと早く処理したいのですが、どうしたらよろしいでしょうか。

Sub 空白列の削除()
Dim UsedCell As Range
Dim Max_column, columnCount As Integer

'使用しているセルの範囲を取得します
Set UsedCell = ActiveSheet.UsedRange
'最大の行番号を取得します
Max_column = UsedCell.Cells(UsedCell.Count).Column
For columnCount = Max_column To 1 Step -1

'Worksheet関数のCountAを使ってデータの個数をカウント
If Application.WorksheetFunction.CountA(Columns(columnCount)) = 0 Then
'行の削除
Columns(columnCount).Delete
End If
Next
End Sub

このQ&Aに関連する最新のQ&A

A 回答 (2件)

こんにちわ


 
これを試してください。

Sub 空白列の削除()
Dim UsedCell As Range
Dim Max_column As Long, columnCount As Long
Dim i As Long, j As Long
Dim 削除前配列 As Variant, 削除後配列 As Variant
Dim Max_gyo As Long
'使用しているセルの範囲を取得します
Set UsedCell = ActiveSheet.UsedRange
'最大の行番号を取得します
Max_column = UsedCell.Columns.Count
Max_gyo = UsedCell.Rows.Count
削除前配列 = UsedCell.Value
ReDim 削除後配列(1 To Max_gyo, 1 To Max_column)
i = 0
For columnCount = 1 To Max_column
'Worksheet関数のCountAを使ってデータの個数をカウント
If Application.WorksheetFunction.CountA(UsedCell.Columns(columnCount)) <> 0 Then
i = i + 1
For j = 1 To Max_gyo
削除後配列(j, i) = 削除前配列(j, columnCount)
Next j
End If
Next columnCount
UsedCell.ClearContents
UsedCell.Resize(Max_gyo, i).Value = 削除後配列
End Sub


それから、たまに間違った説明をしているのを見かけるのですが、
UsedRangeは、A列または、一行目がすべて空白だと、
"A1"からの領域ではないということを意識して、使用してください。
    • good
    • 0
この回答へのお礼

何ということでしょう!あの長い時間かっかった列の削除が一瞬にして実行できました。最初本当に削除したの?という疑いを持ったほどです。本当にありがとうございました。感謝感激です。ありがとうありがとう。

お礼日時:2012/04/30 10:57

こんばんは!


あまりお役に立てないかもしれませんが、
お示しのコードでちゃんと動作するのであれば・・・

画面更新を止めてみてはどうでしょうか?

>For columnCount = ・・・
の行の前に
>Application.ScreenUpdating = False
を追加、

>Next
の後に
>Application.ScreenUpdating = True
を追加。

この程度しか思いつきませんが、時間短縮にならなかったらごめんなさいね。m(_ _)m

この回答への補足

ご指摘の件に関してはすでに試しております。できれば、最大行数が33であることを利用して速度をあげたいです。

補足日時:2012/04/30 09:32
    • good
    • 0

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!


人気Q&Aランキング