Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちらをご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

147 / 13645 ﾂﾘｰ

←次へ　｜　前へ→

▼

【81778】助けてください（配列での抽出について） とりとる 21/5/19(水) 3:16

【81779】Re:助けてください（配列での抽出について） γ 21/5/19(水) 8:38

【81780】Re:助けてください（配列での抽出について） TDS 21/5/19(水) 10:44

【81781】Re:助けてください（配列での抽出について） とりとる 21/5/19(水) 11:54

【81782】Re:助けてください（配列での抽出について） マナ 21/5/19(水) 18:33

【81784】Re:助けてください（配列での抽出について） とりとる 21/5/20(木) 1:08

【81783】Re:助けてください（配列での抽出について） マナ 21/5/19(水) 18:45

【81785】Re:助けてください（配列での抽出について） とりとる 21/5/20(木) 1:20

【81786】Re:助けてください（配列での抽出について） TDS 21/5/20(木) 17:13

【81787】Re:助けてください（配列での抽出について） とりとる 21/5/20(木) 18:12

【81788】Re:助けてください（配列での抽出について） TDS 21/5/20(木) 19:45

【81789】Re:助けてください（配列での抽出について） γ 21/5/24(月) 8:33

【81790】Re:助けてください（配列での抽出について） とりとる 21/5/24(月) 19:24

【81791】Re:助けてください（配列での抽出について） γ 21/5/25(火) 9:45

【81792】Re:助けてください（配列での抽出について） 通りすがり 21/5/26(水) 16:39

【81793】Re:助けてください（配列での抽出について） 通りすがり 21/5/26(水) 16:42


	【81778】助けてください（配列での抽出について）

とりとる - 21/5/19(水) 3:16 -


	引用なし

	パスワード

現在、約35万行・53列からなるブックA(csv)から、必要項目をオートフィルで抽出し、該当する項目の行データをブックBに貼り付けるというマクロを組んで使っているのですが、取り扱うデータが多く、処理に相当な時間がかかるため、配列を使って処理時間の短縮を図ろうと考えています。
流れとしては、二次元配列1にブックAのデータを格納し、必要項目に該当する行データを配列2に格納、別ブックに貼り付けるというものを作成しているのですが、うまくいかず、ご教示頂きたいです。

配列に関してはローカルウィンドウで確認する限りだとうまくいっているように見えるのですが、ResizeとUboundを用いて貼り付けようとしてもまくできません。

現在のコードです。(試作なので、ブックではなくシートで書いています)

Sub test()
　　Dim r As Long, c As Long, n As Long
　　　　r = Sheets("test").Cells(Rows.Count, 1).End(xlUp).Row
　　　　c = 53
　　　　n = 1
　　Dim area1 As Variant, area2() As Variant
　　　　Sheets("test").Select
　　　　area1 = Range(Cells(1, 1), Cells(r, c))

　　For i = LBound(area1, 1) To UBound(area1, 1)
　　　　If area1(i, 2) = "MN" _
　　　　　　Or area1(i, 2) = "SA" Or area1(i, 2) = "SL" Or area1(i, 2) = "SR" Or area1(i, 2) = "SU" _
　　　　　　Or area1(i, 2) = "GK" Or area1(i, 2) = "GS" Or area1(i, 2) = "GC" Or area1(i, 2) = "GH" _
　　　　Then
　　　　　　ReDim Preserve area2(n)
　　　　　　area2(n) = WorksheetFunction.Index(area1, i)
　　　　　　n = n + 1
　　　　End If
　　Next i
　　Sheets("test2").Range("A4").Resize(UBound(area2), 53) = area2
End Sub


	【81779】Re:助けてください（配列での抽出につい...

γ - 21/5/19(水) 8:38 -


	引用なし

	パスワード

area2が配列を要素とする配列なので、シートに書き込めません。まったく別法ですが、フィルタオプションを利用するとよいと思います。オートフィルタよりも相対的に軽いですし、マクロも数行でできます。 10秒以内に終わるはずです。一度トライすることをお薦めします。


	【81780】Re:助けてください（配列での抽出につい...

TDS - 21/5/19(水) 10:44 -


	引用なし

	パスワード

▼とりとるさん：おはようございます。
試しに、オートフィルターで抽出したデータをコピー貼り付けで試してみてください。データ量にもよりますが、２・３０秒くらいで終わるのでは？

Sub test2()
　　'クリップボードにコピーした内容をクリアする
　　Application.CutCopyMode = False
　　'画面表示停止
　　Application.ScreenUpdating = False
　　'抽出データの最終行を求める
　　myRow = Worksheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row
　　'抽出先をクリアする
　　Worksheets("Sheet2").Range("A:K").ClearContents
　　'抽出データをコピーして貼り付け
　　Worksheets("Sheet1").Range("A1:K" & myRow).Copy Worksheets("Sheet2").Range("A1")
　　'画面表示
　　Application.ScreenUpdating = True
　　'クリップボードにコピーした内容をクリアする
　　Application.CutCopyMode = False
　
End Sub


	【81781】Re:助けてください（配列での抽出につい...

とりとる - 21/5/19(水) 11:54 -


	引用なし

	パスワード

▼Yさん、TDS さん：

すみません。
コードには、取込みと関数をコピペするのを記述しており、今回、取込みと関数のコピペで分けて計測したところ、取込みが約15秒、関数のコピペの実行を含むと500秒となり、どうも関数のコピペの手法が悪いようでした。
せっかく教えてい頂いたのにも関わらず、申し訳ございません。

このコピペについては、３行おき行うするため、Until Loopを使って記述しているのですが、これをさらに早くする方法はありますでしょうか？
※画面停止や、手動計算などの高速化は行っています。

　　Dim k, m As Long
　　 k = 4
　　 l = Cells(4, 1).End(xlDown).Row
　　Do Until k > l '最終行まで繰り返す。
　　 Range("BC3:CH3").Copy
　　 Range("BC" & k).PasteSpecial
　　
　　 k = k + 3
　　Loop


	【81782】Re:助けてください（配列での抽出につい...

マナ - 21/5/19(水) 18:33 -


	引用なし

	パスワード

▼とりとるさん：

>　　 k = 4
>　　 l = Cells(4, 1).End(xlDown).Row
>　　Do Until k > l '最終行まで繰り返す。

最終行が35万行ということは、
10万回もコピペを繰り返すのですから遅いのです


	【81783】Re:助けてください（配列での抽出につい...

マナ - 21/5/19(水) 18:45 -


	引用なし

	パスワード

▼とりとるさん：

>配列に関してはローカルウィンドウで確認する限りだとうまくいっているように見えるのですが、ResizeとUboundを用いて貼り付けようとしてもまくできません。

ReDim Preserve area2(1 to n)
と
Sheets("test2").Range("A4").Resize(UBound(area2), 53) = Application.Transpose(Application.Transpose(area2))

これで、貼り付けはできますが

Index関数で、配列から切り出す処理に時間がかかるので
該当するデータが多いと、使い物になりません。

γさん同様、フィルタオプションを推奨します。


	【81784】Re:助けてください（配列での抽出につい...

とりとる - 21/5/20(木) 1:08 -


	引用なし

	パスワード

▼マナさん：

ありがとうございます。
何かはやくする方法はないでしょうか？
ワークシートファンクションなどを使用して、VBAで計算した方が早いでしょうか？
ただ、関数が複雑なものもあり、後から関数を参照したい場合もあるので、できればシート上（Excel）でしたいのですが、無理でしょうか？


	【81785】Re:助けてください（配列での抽出につい...

とりとる - 21/5/20(木) 1:20 -


	引用なし

	パスワード

▼マナさん：

ありがとうございます。
フィルタオプションで抽出するためには、抽出元データに項目行があることと、条件となるキーワードなどをシートに記載したうえで、範囲選択するしかないのでしょうか？

現在の抽出元のデータ(csv)には、項目がなく、抽出したい項目のところに行挿入のうえ、条件対象列にのみ項目を入れ、別シートに記載している条件となるキーワードを記載して、そこを範囲選択しているのですが、うまくいきません。
また、条件となるキーワード等もできればコードに直接記載したいのですが、できないのでしょうか？

聞いてばかりですみませんがご教示頂ければ幸いです。

　　Dim r As Long, c As Long　
　　　　r = Sheets("test").Cells(Rows.Count, 1).End(xlUp).Row
　　　　c = 53
　　Dim ds As Worksheet
　　　　Set ds = Worksheets("test")
　　Dim key As Range
　　　　Set key = Sheets("基礎情報").Range("E17:E25")
　　
　　With ds
　　　　.Rows(1).Insert
　　　　.Cells(1, 2) = "項目"
　　　　.Range(Cells(1, 2), Cells(r, c)).AdvancedFilter _
　　　　　　Action:=xlFilterCopy, _
　　　　　　CriteriaRange:=key, _
　　　　　　CopyToRange:=Sheets("test2").Range("A5:BB" & r + 5), _
　　　　　　Unique:=False
　　　　.Rows(1).Delete
　　End With
End Sub


	【81786】Re:助けてください（配列での抽出につい...

TDS - 21/5/20(木) 17:13 -


	引用なし

	パスワード

▼とりとるさん：
CSVをOPENで読み込んで、必要な条件でデータを読み込むようにしてはどうですか？
サンプルとして、strSplit(1)で、”なごや”　と入っているデータのみ取り込む。

strSplit(0)・・・１列目のデータ
strSplit(1)・・・２列目のデータ
strSplit(2)・・・３列目のデータ　　と、35列あれば、strSplit(0)～strSplit(34)までです。

少しは、早くなると思います。
必要な条件データは、ＦＯＲＭ画面を作成し、取込めばいいかと。
参考までに・・・

Sub CSV入力1()
　　Dim varFileName As Variant
　　Dim intFree As Integer
　　Dim strRec As String
　　Dim strSplit() As String
　　Dim i As Long, j As Long

　　'クリップボードにコピーした内容をクリアする
　　Application.CutCopyMode = False
　　'画面表示停止
　　Application.ScreenUpdating = False

　　varFileName = Application.GetOpenFilename(FileFilter:="CSVファイル(*.csv),*.csv", _
　　　　　　　　　　　　　　　　　　　　　　　　Title:="CSVファイルの選択")
　　If varFileName = False Then
　　　　Exit Sub
　　End If

　　intFree = FreeFile '空番号を取得
　　Open varFileName For Input As #intFree 'CSVファィルをオープン

　　'抽出先をクリアする
　　Sheet2.Range("A:Z").ClearContents

Debug.Print Format(Time, "hh:mm:ss")
　
　　i = 0
　　Do Until EOF(intFree)
　　　　Line Input #intFree, strRec '1行読み込み
　　　　strSplit = Split(strRec, ",") 'カンマ区切りで配列へ
　　　　
　　　　'*** 必要なデータのみ読み込む　２列目がなごやのデータ
　　　　If strSplit(1) = "なごや" Then
　　　　　i = i + 1
　　　　　For j = 0 To UBound(strSplit)
　　　　　　
　　　　　　　Sheet2.Cells(i, j + 1).Value = strSplit(j)
　　　　　　
　　　　　Next
　　　　'配列をそのまま入れる方法も、ただし全て文字列として入力される
　　　　'Range(Cells(i, 1), Cells(i, UBound(strSplit) + 1)) = strSplit
　　　　End If
　　Loop
　
　　 Close #intFree

Debug.Print Format(Time, "hh:mm:ss")
　　'画面表示
　　Application.ScreenUpdating = True
　　'クリップボードにコピーした内容をクリアする
　　Application.CutCopyMode = False

End Sub


	【81787】Re:助けてください（配列での抽出につい...

とりとる - 21/5/20(木) 18:12 -


	引用なし

	パスワード

▼TDS さん：
ありがとうございます。

なかなか難しいそうですが、参考を元に挑戦してみます。

取り込みした後なのですが、関数のあるセルを相対参照でコピペする作業があります。この作業も、データ数、行数が多いため、取り込みよりも時間が掛かってしまっている状況であり、早くする方法を模索しているのですが、なにか良い方法はないでしょう？

何度も質問してすみません。


	【81788】Re:助けてください（配列での抽出につい...

TDS - 21/5/20(木) 19:45 -


	引用なし

	パスワード

▼とりとるさん：
前もって式だけ作成しておけば良いと思いますが。
セルは空欄で、D列やG列に式を作っておいて、式だけコピー貼り付けする。35万件分コピーしておく。取込み用の式だけ入った、EXCEL表を事前に作成する。

CSVを読み込んで、値だけセットする。
式の入っているとこには、値をセットしないで、次の列へ値をセットする感じ？


	【81789】Re:助けてください（配列での抽出につい...

γ - 21/5/24(月) 8:33 -


	引用なし

	パスワード

■フィルタオプションの件。 AdvancedFilterメソッドで引数などにしている情報を見れば、いずれもワークシート上に情報を置き、それを利用することが前提になっています。ですから、マクロを使って、そういう状況を作ればよいだけの話です。・見出しは当然必要です。それがなければ、項目の特定ができません。　itm1,itm2,・・・の如き見出しを機械的につければいいだけで、　これはワークシート上で、「連続データ」機能を使ってもいいし、簡単なマクロ　で可能です。・検索条件範囲の値設定も、そこにマクロで値をセットすればよいだけの話です。こうしたことを理解しようとせず、ご自分のやり方（見出し省略。別の情報入力形態？）を開拓しようとしても徒労に終わるだけです。いやいやされようとしている印象が、文章からにじみ出ていますが、強制する積もりはありません（こちらには何の益もありませんから）。当然ながら選択はご自由です。 ■3件おきコピーに時間を要しているという、最大の課題と目されている点に　ついて。 (1)35万行ですか、多数のようですが、計算式も一度作成してしまえば繰り返し　作成する必要もない、という考え方が一つ。 (2)仮に、繰り返し実行するとしたときの、時間短縮方策の有無。　３行おき、ということで、もしその間は何もないという前提なら、　以下の方法があります。　・空白行を含む3行をまとめて、広い行数に一度にコピーペイストすれば、　　一行毎にコピーペイストするよりも効率は上がります。　・その際、「空白セルを無視する」オプションを利用するのがキモ。　　・ただし、一度に実行すると、リソース不足となるかもしれないので、　　その際は、小分けにして貼り付けるとよいと思われます。　・少なくとも、一行毎に貼り付けるよりも、時間短縮にはなります。


	【81790】Re:助けてください（配列での抽出につい...

とりとる - 21/5/24(月) 19:24 -


	引用なし

	パスワード

▼γ さん：

返信ありがとうございます。

不快な思いをさせてしまい申し訳ありませんでした。
いやいやしているつもりはなく、項目を省略などの方法があればと思い質問させて頂いた次第でした。
vbaの知識もとい、フィルタオプションの知識や理解が少ない状態でしたので、色々と調べながらも、項目の省略はできないのかなと簡単に考えてしまい、質問してしまいました。

今後は、このような質問はしないようにします。
それでも質問させて頂く祭には、yさんのように、理解がない状態での質問に不快に感じてしまう方が居られることを意識し、あらかじめ、理解が出来ていないこと、それが故に質問文に失礼があるかもしれないことを記載した上で利用させて頂ければと思います。
すみませんでした。

他に
>■フィルタオプションの件。
>AdvancedFilterメソッドで引数などにしている情報を見れば、
>いずれもワークシート上に情報を置き、それを利用することが前提になっています。
>ですから、マクロを使って、そういう状況を作ればよいだけの話です。
>・見出しは当然必要です。それがなければ、項目の特定ができません。
>　itm1,itm2,・・・の如き見出しを機械的につければいいだけで、
>　これはワークシート上で、「連続データ」機能を使ってもいいし、簡単なマクロ
>　で可能です。
>・検索条件範囲の値設定も、そこにマクロで値をセットすればよいだけの話です。
>
>こうしたことを理解しようとせず、ご自分のやり方（見出し省略。別の情報入力
>形態？）を開拓しようとしても徒労に終わるだけです。
>いやいやされようとしている印象が、文章からにじみ出ていますが、
>強制する積もりはありません（こちらには何の益もありませんから）。
>当然ながら選択はご自由です。
>
>■3件おきコピーに時間を要しているという、最大の課題と目されている点に
>　ついて。
>(1)35万行ですか、多数のようですが、計算式も一度作成してしまえば繰り返し
>　作成する必要もない、という考え方が一つ。
>(2)仮に、繰り返し実行するとしたときの、時間短縮方策の有無。
>　３行おき、ということで、もしその間は何もないという前提なら、
>　以下の方法があります。
>　・空白行を含む3行をまとめて、広い行数に一度にコピーペイストすれば、
>　　一行毎にコピーペイストするよりも効率は上がります。
>　・その際、「空白セルを無視する」オプションを利用するのがキモ。　
>　・ただし、一度に実行すると、リソース不足となるかもしれないので、
>　　その際は、小分けにして貼り付けるとよいと思われます。
>　・少なくとも、一行毎に貼り付けるよりも、時間短縮にはなります。


	【81791】Re:助けてください（配列での抽出につい...

γ - 21/5/25(火) 9:45 -


	引用なし

	パスワード

>理解がない状態での質問に不快に感じてしまう
何を言っているんですかね、理解に苦しむ。

1)見出しは省略したい、
2)条件範囲の内容をシートを経由せずに直接指定したい
といった条件で待ち構えていて、それに合わせる話が真っ先にくるのは、
妙な話だと感じた。
提案があったんだから、まずは、普通の決められたやり方で機能を満たすものを
作るのが筋でしょう？
単に知らなかったからと言われるが、それならなおさらのこと、
書籍等に書かれている普通のやりかたで、まずは機能の実現を目指すべきでしょう？違いますか？

こういう回答者もいるから、これからは気をつけないと、的なことを言われて、
初めて本当に不快でした。その言葉は、そっくりあなたに返します。

また、もう一つのより切実とされる問題への言及についてノーコメントなことも理解に苦しむ。（これに対するコメントはもう要らない。）


	【81792】Re:助けてください（配列での抽出につい...

通りすがり - 21/5/26(水) 16:39 -


	引用なし

	パスワード

横から失礼します。

>yさんのように、理解がない状態での質問に不快に感じてしまう方が居られることを意識し

「理解がない」は主語が省略されてますね。

主語は質問者さん自身のことを指してるように読めます。
ɤさんのことを理解がないと言ってるのではないと思います。


	【81793】Re:助けてください（配列での抽出につい...

通りすがり - 21/5/26(水) 16:42 -


	引用なし

	パスワード

文字化けしました。
正しくは、
γさんのことを理解がないと言ってるのではないと思います。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

147 / 13645 ﾂﾘｰ

←次へ　｜　前へ→

ページ：

┃

記事番号：

(SS)C-BOARD v3.8 is Free