4月17日はQueenの日!フレディ・マーキュリーの年代別ファッション&ヒットソングまとめ

こんにちは。以前こちらで横並びのデータを縦並びにしたいという質問に、VBAで解決して下さいました。
あの後順調にきていましたが、最近マクロを実行すると終わるまで15分ほどかかってしまいます。

以前教えていただいたコードはこちらです。

Sub Sample4() '//この行から
Dim i As Long, j As Long, cnt As Long, lastRow As Long, wS As Worksheet
Set wS = Worksheets("仕入表")
With Worksheets("在庫表")
'//E列で「在庫表」Sheetの最終行取得★
lastRow = .Cells(Rows.Count, "E").End(xlUp).Row
'//「在庫表」SheetにデータがあればD列2行目~I列最終行データを一旦消去
If lastRow > 1 Then
Range(.Cells(2, "D"), .Cells(lastRow, "I")).ClearContents
End If
cnt = 1
For i = 3 To wS.Cells(Rows.Count, "A").End(xlUp).Row '//「仕入表」Sheetの3行目~A列最終行まで
For j = 5 To wS.Cells(i, Columns.Count).End(xlToLeft).Column Step 2 '//E列~i行最終列まで2行毎★
If wS.Cells(i, j) <> 0 Then '//画像で「0」が表示されているので「0」以外を追加★
cnt = cnt + 1
'//最初のデータ行のみ「仕入表」Sheetの日付をD列に表示★
If j = 5 Then
.Cells(cnt, "D") = wS.Cells(i, "A")
End If
.Cells(cnt, "E") = wS.Cells(i, "B") '//B列に「コード」を表示
.Cells(cnt, "F") = wS.Cells(i, "C") '//F列に「商品名」を表示
.Cells(cnt, "G") = wS.Cells(i, "D") '//G列に「下代」を表示
.Cells(cnt, "H") = wS.Cells(i, j) '//H列に「色」を表示
.Cells(cnt, "I") = wS.Cells(i, j + 1) '//I列に「数」を表示
End If
Next j
Next i
'//最後にD列の表示形式(日付)を「在庫表」SheetのA3セルの書式に設定★
.Range("D:D").NumberFormatLocal = wS.Range("A3").NumberFormatLocal
End With
End Sub '//この行まで

補足ですが、仕入表に入力した情報を在庫表に転記させたいという質問でした。
終わりの行から続きを入力する形でよいのですが、”在庫表」SheetにデータがあればD列2行目~I列最終行データを一旦消去”という処理が遅くさせてるということはありますか?


データが何千行にもなっています。
解決策があれば教えていただきたいです。よろしくお願いします。

質問者からの補足コメント

  • つらい・・・

    Sub Sample4() '//この行から
    Dim i As Long, j As Long, cnt As Long, lastRow As Long, wS As Worksheet
    Application.ScreenUpdating = False




    End With
    Application.ScreenUpdating = True
    End Sub '//この行まで

    入れ方はこちらであってますか?
    これと.Range(.Cells(2, "D"), .Cells(lastRow, "I")).ClearContents
    を試しましたが変わりませんでした><

    ありがとうございます。

    No.1の回答に寄せられた補足コメントです。 補足日時:2017/03/10 12:04
  • うーん・・・

    https://oshiete.goo.ne.jp/qa/8980328.html

    以前の質問です。取り急ぎこちらを張り付けします。よろしくお願いします。

      補足日時:2017/03/10 13:34
  • ありがとうございます。

    元データはA~X列までの大体1000行程度です。

    実行先は3000行程度までなります。列はD~Iまでです。

    No.4の回答に寄せられた補足コメントです。 補足日時:2017/03/10 13:37
  • 在庫表のタブには数式は入ってませんが、元データの仕入表タブには計算式がたくさんはいってますし、同じファイルの他のタブにも沢山計算式が入ってます・。。
    それが原因でしょうか・・・

    No.5の回答に寄せられた補足コメントです。 補足日時:2017/03/10 13:46
  • HAPPY

    皆さん色々なアドバイスありがとうございます!!
    とりあえず7番さんと9番さんのを実行したら一瞬でマクロが実行されました!!!!!
    ありがとうございます!!!!!!!!!!!!!!

    ですが、実行の後に、「実行時エラー’13   型が一致しません」
    と出てきました。これは何でしょうか・・・無視しても大丈夫ですか?

    No.9の回答に寄せられた補足コメントです。 補足日時:2017/03/13 09:58
  • ありがとうございます。
    教えて下ったコードを追加したらマクロが実行できずにエラーになってしまいました。。
    たいへん恐れ入りますが、最初からコードを書いていただくことはできますか・・・?

    No.10の回答に寄せられた補足コメントです。 補足日時:2017/03/15 12:15
  • うーん・・・

    エラー13の表示が出たときにデバック?というボタンを押したらVBAのコードで以下の部分が黄色で色付けされていました。

    If wS.Cells(i, j) <> 0 Then '//画像で「0」が表示されているので「0」以外を追加★

      補足日時:2017/03/16 10:13
  • つらい・・・

    本当にありがとうございます。
    時間をかけてくださって感謝してます。

    教えていただいたコードをペーストして実行したら、「コンパイルエラー NEXTに対するFORがありません」とでました。
    OKを押したらVBAが出てきて、
    Sub Sample4() '//この行から
    この部分が黄色になり、
    Next j
    にカーソルが入ってます。

      補足日時:2017/03/17 17:02

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

A 回答 (17件中1~10件)

No.7、12の者です。



>03/17 17:02の補足について

コードのコピペや追加・削除を繰り返すうちに、必要な部分を消してしまったのだと思います。
現在実行しているコードをUPしましょう。^^
    • good
    • 0

#15の補足


画像ファイルで、感じを掴んでください。
基本的には、赤い四角で囲った所を入れるだけのスタイルです。
若干、私のものには違いはありますが、検査用のマクロですから、元のご質問に使ったままで良く、ほかはいじらなくてもよいです。
その下に、シートエラーチェッカーの補助マクロを貼り付けた、というようになっています。
「最近急にVBAの処理速度が遅くなりました」の回答画像17
    • good
    • 0
この回答へのお礼

すみません、いろいろとありがとうございました!!
遅くなってしまい申し訳ございません。まだ最後の回答の実践ができておりませんが、質問が締め切られてしまいましたので。
そしてベストアンサー間違えてしまいました><皆さんにはとても感謝してますが、WindFallerさん親身になってくださり、とても感謝してます。ありがとうございました!

お礼日時:2017/03/27 12:19

こんにちは。



最初のご質問から、全部見直しました。意外にも早く終わりました。

結論からすると、エラー自体が入る可能性は、#12さんご指摘でも、私のもあるように、エラーは、マクロ内部からのものではなかったことが分かりました。

a.Value = b.Value
で、これは、エラーが入る入れ物ではないというエラーです。

今のコードからも、私自身もコードを書いてみましたが、不可抗力のエラーを取り除くことは、内容のマクロコードが非常にわかりづらくなってしまいます。

そこで、私が考えだした方法ですが、仕入表のエラーチェックをする、「シートエラーチェッカー」をつけることにしました。もちろん、在庫表を同じようにしても構いません。マクロ自体を書き換えるにしても、一行を差し入れればすみます。

なお、こちらのマクロをお見せするかどうかは迷うところです。
コードの考え方も違いますが、見かけでひとつだけ違いがあるのは、将来、データベースなどに切り替えるときに、日付値が抜けているものはデータ化できませんので、日付値を入れて、それを白で隠す方法にしました。

'//
Sub Sample4() '//この行から
Dim i As Long, j As Long, cnt As Long, lastRow As Long, wS As Worksheet
Set wS = Worksheets("仕入表")

Call SheetErrChecker(wS) 'シートエラーチェッカー ●
With Worksheets("在庫表")
'//E列で「在庫表」Sheetの最終行取得★




End Sub

'同じ場所の下に貼り付けます。
'エラー値を削除してしまう、サブルーチン型マクロです。
Private Sub SheetErrChecker(ByRef sh As Worksheet)
Dim pErr As Range
With sh
On Error Resume Next
Set pErr = .UsedRange.SpecialCells(xlCellTypeConstants, 16)
If Not pErr Is Nothing Then
  pErr.ClearContents
End If
Set pErr = .UsedRange.SpecialCells(xlCellTypeFormulas, 16)
If Not pErr Is Nothing Then
  pErr.ClearContents
End If
On Error GoTo 0
End With
End Sub
    • good
    • 0

できるできないはともかくとして、再度、全部を見直させていただいてよろしいでしょうか。



たぶん、この
「横並びのデータを条件付きで縦に転記させたい」
https://oshiete.goo.ne.jp/qa/8980328.html
2015/05/12 00:31

の分だと思います。期限は、来週の月曜日一杯までにさせてください。
元の作った方は、ここの常連の方で、私の作り方とはまったく違うもので、競合しあうことはありません。ただ、その後、いろいろ変わった部分がある場合には、もう手の届かないものになってしまうでしょうけれども。

よろしくお願いします。
    • good
    • 0

#11の回答者です。


たいへんに申し訳ありません。

実際に、If wS.Cells(i, j) <> 0

IsNumeric は、「ws.Cells(i, j)が数値だったら」ではなく、数式のエラーが入っていると考えたのです。

IsNumeric は、数式のエラー値を持った時には、それを弾き、また、数字であることも検査するので、そのあとで、0 と比較していることで、そういうようなエラーチェック処理を考えたのです。

そして、もし、ws.Cells(i, j)この処理の範囲でエラーが出たら、それが判るような、On Error トラップを考えたわけです。途中で止まれば、その場所が判るわけです。


× If IsError(ws.Cells(i, j).Address) = False Then
If IsError(ws.Cells(i, j)) Then  'こちらの方が良い。
msg = ws.Cells(i, j).Address  '←このアドレス自体にエラーがあるかどうか。
End If
MsgBox Err.Number & ": " & Err.Description & vbCrLf & msg

しかし、そのようなOn Error トラップをつけても、そこには反応しなかったとなると、それを深追いするよりも原点に戻るべきかなとは思います。

それを直すには、その表の全体の作りの最初から、見ていかなくてはならないかもしれません。
    • good
    • 0

No.7です。



WindFallerさんがNo.11で追加したコード
>If IsNumeric(ws.Cells(i, j)) Then
これは「ws.Cells(i, j)が数値だったら」という式です。
でもこのセルは色を示す文字列であって数値ではないのですよね。
なのでここで全てはじかれてしまい、データの転記がされていません。

>If IsNumeric(ws.Cells(i, j)) Then
を追加する前のコードで、質問者様が補足コメントにお書きになった
>エラー13の表示が出たときにデバック?というボタンを押したらVBAのコードで
>以下の部分が黄色で色付けされていました。
>If wS.Cells(i, j) <> 0 Then '//画像で「0」が表示されているので「0」以外を追加★
については、仕入表のシートで式がエラーになっているためではないかと推測しますがいかがでしょうか?
そちらの式でエラーを出さないようにはできませんか?
    • good
    • 0

エラーチェック版です。


'//
Sub Sample4er() '//この行から
Dim i As Long, j As Long, cnt As Long, lastRow As Long, ws As Worksheet
On Error GoTo ErrHandler
Set ws = Worksheets("仕入表")
With Worksheets("在庫表")
''//E列で「在庫表」Sheetの最終行取得★
lastRow = .Cells(Rows.Count, "E").End(xlUp).Row
''//「在庫表」SheetにデータがあればD列2行目~I列最終行データを一旦消去
If lastRow > 1 Then
Range(.Cells(2, "D"), .Cells(lastRow, "I")).ClearContents
End If
cnt = 1
For i = 3 To ws.Cells(Rows.Count, "A").End(xlUp).Row '//「仕入表」Sheetの3行目~A列最終行まで
For j = 5 To ws.Cells(i, Columns.Count).End(xlToLeft).Column Step 2 '//E列~i行最終列まで2行毎★

If IsNumeric(ws.Cells(i, j)) Then
If ws.Cells(i, j) <> 0 Then '//画像で「0」が表示されているので「0」以外を追加★
cnt = cnt + 1
''//最初のデータ行のみ「仕入表」Sheetの日付をD列に表示★
If j = 5 Then
.Cells(cnt, "D") = ws.Cells(i, "A")
End If
.Cells(cnt, "E") = ws.Cells(i, "B") '//B列に「コード」を表示
.Cells(cnt, "F") = ws.Cells(i, "C") '//F列に「商品名」を表示
.Cells(cnt, "G") = ws.Cells(i, "D") '//G列に「下代」を表示
.Cells(cnt, "H") = ws.Cells(i, j) '//H列に「色」を表示
.Cells(cnt, "I") = ws.Cells(i, j + 1) '//I列に「数」を表示
End If
End If
Next j
Next i
' //最後にD列の表示形式(日付)を「在庫表」SheetのA3セルの書式に設定★
.Range("D:D").NumberFormatLocal = ws.Range("A3").NumberFormatLocal
End With
Exit Sub
ErrHandler:
Dim msg
If IsError(ws.Cells(i, j).Address) = False Then
msg = ws.Cells(i, j).Address
End If
MsgBox Err.Number & ": " & Err.Description & vbCrLf & msg
End Sub '//この行まで
    • good
    • 0
この回答へのお礼

ありっがとうございます。こちらのコードでマクロを実行したら今まで入ってたデータも含めて消えてしまいました><

お礼日時:2017/03/16 10:09

#9の回答者です。



>実行の後に、「実行時エラー’13   型が一致しません」
>と出てきました。これは何でしょうか・・・無視しても大丈夫ですか?

できれば、その場所を特定したいと思います。

On Error Resume Next でエラーは無視はできますが、
それでは、エラーは放置したままになってしまいます。
ふつう、期待される変数の型と代入の値の型とあっていないことが多いですね。

例えば、

Dim myVal As Date
myVal = DateValue("2017/3/32")
の場合に、そのようなエラーが出ます。
myVal = DateValue("2017/3/31") ならOKです。

次は、
ActiveCell には、エラーが出ている場合。
Dim myVal As Long
myVal = ActiveCell

'---------------------------------
今、コードをみましたが、いろいろなデータで、シュミレートしてみたところ、以下の部分で、エラー(13)が排出します。
シートの中がエラーが出ていなければ、本来エラーは出ないかもしれません。

前のコードから見直すべきなのか思案中です。

ここと決まっているわけではありませんが、あくまでも、こちらの想像の範囲です。
 If wS.Cells(i, j) <> 0 Then '//画像で「0」が表示されているので「0」以外を追加★

その対処法としては、例えば、
 If IsNumeric(wS.Cells(i, j)) Then '←加える
  If wS.Cells(i, j) <> 0 Then '//画像で「0」が表示されているので「0」以外を追加★

  End If
 End if  '←加える
この回答への補足あり
    • good
    • 0

こんにちは。




>'//最後にD列の表示形式(日付)を「在庫表」SheetのA3セルの書式に設定★
>.Range("D:D").NumberFormatLocal = wS.Range("A3").NumberFormatLocal

基本的なことですが、D:D 列全体のような使い方は、その組み合わせが複雑なほど、重くなってしまいます。

全列および全行の参照が良い場合とそうでない場合があります。組み込み関数などでは、行の最終セルまでですから、問題ありませんが、この場合は、まともに、最後の行まで書いてしまっていますから、ここはうまくありません。(これを書いた人には申し訳ないのですが、セルに書き込む場合は、無駄になってしまうし、重くなってしまうので、全行の参照はやめたほうがよいです)

このような方式に換えたほうがよいです。
.Range("D1", Cells(Rows.Count, 4).End(xlUp)).NumberFormatLocal =wS.Range("A3").NumberFormatLocal

ただし、例外はCells(全体のセル) に書き込む時だけは、問題が回避されます。

https://msdn.microsoft.com/ja-jp/library/office/ …
Excel 2010 のパフォーマンス: パフォーマンスの問題を最適化するヒント:全列および全行の参照


#7様が書かれている
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
のくだりは必要です。


もうひとつは、VBAの場合は、設定によりますが、VBA Editor のツール--オプションで、コンパイルの方法を、順次コンパイル+「場合によって:バックグラウンド・コンパイル」にしておいたら変化するかどうか試してみる価値はあります。(変化しない場合も多いのですが)


VBAの高速化とは
「コードの実行中は必要な機能以外すべて無効にする」ということです。
それに加えて、セルへのアクセスを減らすことです。今は、細かいところまで見ていませんので、それについては、この程度にとどめておきます。

参考サイト:
「Excel 2010 のパフォーマンス: パフォーマンスの問題を最適化するヒント」
https://msdn.microsoft.com/ja-jp/library/office/ …
この回答への補足あり
    • good
    • 0

最速化してみました。


列のループは最大10色ということなので、23列までループするようにしました。
色の値が0の時、列のループを打ち切るようにしました。
ロジック的に最速化できるのは、以上の項目のみです。
更新中の画面表示をしないようにしました。
これで改善しない場合は、他に原因があるかと。

Sub Sample4() '//この行から
Dim i As Long, j As Long, cnt As Long, lastRow As Long, wS As Worksheet
Set wS = Worksheets("仕入表")
Application.ScreenUpdating = False
With Worksheets("在庫表")
'//E列で「在庫表」Sheetの最終行取得★
lastRow = .Cells(Rows.Count, "E").End(xlUp).Row
'//「在庫表」SheetにデータがあればD列2行目~I列最終行データを一旦消去
If lastRow > 1 Then
Range(.Cells(2, "D"), .Cells(lastRow, "I")).ClearContents
End If
cnt = 1
For i = 3 To wS.Cells(Rows.Count, "A").End(xlUp).Row '//「仕入表」Sheetの3行目~A列最終行まで
For j = 5 To 23 Step 2 '//E列~i行最終列まで2行毎★ '//////////goo修正
If wS.Cells(i, j).Value = 0 Then Exit For '//////////goo修正
cnt = cnt + 1
'//最初のデータ行のみ「仕入表」Sheetの日付をD列に表示★
If j = 5 Then
.Cells(cnt, "D") = wS.Cells(i, "A")
End If
.Cells(cnt, "E") = wS.Cells(i, "B") '//E列に「コード」を表示
.Cells(cnt, "F") = wS.Cells(i, "C") '//F列に「商品名」を表示
.Cells(cnt, "G") = wS.Cells(i, "D") '//G列に「下代」を表示
.Cells(cnt, "H") = wS.Cells(i, j) '//H列に「色」を表示
.Cells(cnt, "I") = wS.Cells(i, j + 1) '//I列に「数」を表示
Next j
Next i
'//最後にD列の表示形式(日付)を「在庫表」SheetのA3セルの書式に設定★
.Range("D:D").NumberFormatLocal = wS.Range("A3").NumberFormatLocal
End With
Application.ScreenUpdating = True
End Sub '//この行まで
    • good
    • 0

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


人気Q&Aランキング