質問をすることでしか得られない、回答やアドバイスがある。

15分調べてもわからないことは、質問しよう!

新規登録して質問してみよう
ただいま回答率
85.50%
VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

配列

配列は、各データの要素(値または変数)が連続的に並べられたデータ構造です。各配列は添え字(INDEX)で識別されています。

Q&A

解決済

3回答

3668閲覧

エクセルVBA指定文字数を抽出したい

cd987456

総合スコア33

VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

配列

配列は、各データの要素(値または変数)が連続的に並べられたデータ構造です。各配列は添え字(INDEX)で識別されています。

0グッド

0クリップ

投稿2017/06/29 05:41

エクセルファイルに”抽出結果”というシートがあり、"着手予定日"という列があります。
セルには9桁の数字が入っています。
1桁目~8桁目までで西暦4桁+月2桁+日2桁を表しています。9桁目は1が入っています。
やりたい事は9桁目の1を一括で消したいです。できるだけ高速処理したいです。

対象数は毎回違うのですが、最大90万くらいです。
FOR~NEXT で処理すると私のパソコンで40万で6秒くらいです。
コードを以下に書きました。

★例えば、配列に格納し、格納したデータから指定文字数を抽出などできますか?
FOR~NEXTより早くできる処理を御存知の方、教えて下さい。

Sub 末番削除() Dim CNT As Long, I As Long, COL As Long Dim maxrow As Long Dim MAXCOL As Long With Sheets("抽出結果").Range("A1").SpecialCells(xlLastCell) maxrow = .Row MAXCOL = .Column End With With Sheets("抽出結果") CNT = WorksheetFunction.CountIf(.Range(.Cells(2, 1), .Cells(2, MAXCOL)), "着手予定日") If CNT > 0 Then COL = .Rows(2).Find("着手予定日").Column For I = 4 To maxrow .Cells(I, COL).Value = Mid(.Cells(I, COL), 1, 8) Next I Else: End If End With End Sub

※"着手予定日"の列番を探しているのは"抽出結果"シートには色々なデータが表示できるように
してある為、ない場合もあるからです。

気になる質問をクリップする

クリップした質問は、後からいつでもMYページで確認できます。

またクリップした質問に回答があった際、通知やメールを受け取ることができます。

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

guest

回答3

0

ベストアンサー

配列に格納して、配列で9桁→8桁変換してから、もとのレンジに戻す。
試してないけど、どのくらい改善できるかな。
結果がでたら報告してほしいです。

Sub 末番削除_配列版() Dim Row As Long, Col As Long Dim maxrow As Long Dim MAXCOL As Long Dim ColumnNames() '列名格納用配列 Dim ColumnValues() '列のデータ格納用配列 Dim rng As Range Application.ScreenUpdating = False With Sheets("抽出結果") With .Range("A1").SpecialCells(xlLastCell) maxrow = .Row MAXCOL = .Column End With ColumnNames = .Range(.Cells(2, 1), .Cells(2, MAXCOL)).Value For Col = 1 To MAXCOL If ColumnNames(1, Col) = "着手予定日" Then Set rng = .Range(.Cells(4, Col), .Cells(maxrow, Col)) ColumnValues = rng.Value For Row = 4 To maxrow ColumnValues(Row - 3, 1) = Left(ColumnValues(Row - 3, 1), 8) Next rng.Value = ColumnValues End If Next End With Application.ScreenUpdating = True End Sub

投稿2017/06/29 07:27

hatena19

総合スコア33620

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

jawa

2017/06/29 07:41

hatenaさんの回答の直後に似たような回答を投稿してしまいましたが、こちらのほうが優秀です。 私のコードと決定的に違うのが値のセットの仕方です。 私のはセル範囲から値を取り出してその値をセルに戻していましたが、hatenaさんのはセル範囲の値をまとめて配列に格納し、その配列をループして処理した結果をセルに戻しているので、セルからの取り出し・書き出しが1回ずつで済んでいるというところです。 ちなみに私のコードを計測したものと同じデータを使って計測したところ、3秒/40万件で処理が終わりました。 (/^ー^)/"""パチパチ
cd987456

2017/06/29 08:33

hatena19さん 回答ありがとうございます。劇的に早くなりました。私のパソコンで2秒くらいでした。 配列恐るべしです。ありがとうございました。
guest

0

ttyp03さんのアドバイスにもありますが、処理速度の改善には画面描画OFFが基本です。

あと、セルの値を直接参照するよりも対象範囲を変数に格納して参照する方が早くなります。

Sub 末番削除2() Dim CNT As Long, I As Long, COL As Long Dim maxrow As Long Dim MAXCOL As Long Dim area As Range '処理範囲 Cells(1, 1) = Now '画面描画OFF Application.ScreenUpdating = False With Sheets("抽出結果").Range("A1").SpecialCells(xlLastCell) maxrow = .Row MAXCOL = .Column End With With Sheets("抽出結果") CNT = WorksheetFunction.CountIf(.Range(.Cells(2, 1), .Cells(2, MAXCOL)), "着手予定日") If CNT > 0 Then COL = .Rows(2).Find("着手予定日").Column '処理範囲を変数に格納 Set area = .Range(.Cells(4, COL), .Cells(maxrow, COL)) '範囲内に含まれるセルをループ処理 For Each c In area c.Value = Mid(c.Value, 1, 8) Next Else: End If End With '画面描画ON Application.ScreenUpdating = True Cells(1, 2) = Now End Sub

私の環境では、提示いただいたコードのままだと71秒/40万件でした。
これが参照範囲を変数に格納する対応のみ入れることで26~7秒/40万件となりました。
加えて画面描画OFFの対応も入れてみましたが、こちらも27秒前後とかわらず。
試しに画面描画OFFの対応だけでも動作させてみましたが、これは30秒前後と若干ですが差が出ました。

データ量によっては目に見えて差が出ることにもなりますので、できうる対応はしておいた方がよさそうですね。

参考になれば幸いです。

投稿2017/06/29 07:31

jawa

総合スコア3013

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

cd987456

2017/06/29 08:29

jawaさん 回答ありがとうございます。参考にさせて頂きます。
guest

0

40万で6秒ですか。
随分速いPCですな。
私の環境でやったら30秒かかりましたよ。とほほ。
それはさておき、とりあえずですが、描画の更新をしないとだいぶ改善されると思うので、次のようにしてみてください。
私の環境では3倍ほど速くなりました。

VBA

1Application.ScreenUpdating = False 2For I = 4 To maxrow 3 .Cells(I, COL).Value = Mid(.Cells(I, COL), 1, 8) 4Next I 5Application.ScreenUpdating = True

投稿2017/06/29 06:00

ttyp03

総合スコア16996

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

cd987456

2017/06/29 08:25

ttyp03さん 回答ありがとうございます。御指摘ありがとうございます。 描画OFFしたら少し早くなりました。ありがとうございます。
guest

あなたの回答

tips

太字

斜体

打ち消し線

見出し

引用テキストの挿入

コードの挿入

リンクの挿入

リストの挿入

番号リストの挿入

表の挿入

水平線の挿入

プレビュー

15分調べてもわからないことは
teratailで質問しよう!

ただいまの回答率
85.50%

質問をまとめることで
思考を整理して素早く解決

テンプレート機能で
簡単に質問をまとめる

質問する

関連した質問