Excel VBA質問箱 IV

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

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


36 / 3841 ページ ←次へ | 前へ→

【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関数で、配列から切り出す処理に時間がかかるので
該当するデータが多いと、使い物になりません。

γさん同様、フィルタオプションを推奨します。
・ツリー全体表示

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

引用なし
パスワード
   ▼とりとる さん:

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

最終行が35万行ということは、
10万回もコピペを繰り返すのですから遅いのです
・ツリー全体表示

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

引用なし
パスワード
   ▼Yさん、TDS さん:

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

このコピペについては、3行おき行うするため、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
・ツリー全体表示

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

引用なし
パスワード
   ▼とりとる さん:おはようございます。
試しに、オートフィルターで抽出したデータをコピー貼り付けで試してみてください。データ量にもよりますが、2・30秒くらいで終わるのでは?

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
・ツリー全体表示

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

引用なし
パスワード
   area2が配列を要素とする配列なので、シートに書き込めません。

まったく別法ですが、フィルタオプションを利用するとよいと思います。

オートフィルタよりも相対的に軽いですし、マクロも数行でできます。
10秒以内に終わるはずです。
一度トライすることをお薦めします。
・ツリー全体表示

【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
・ツリー全体表示

【81777】Re:セルの情報を取得し、任意のセルに色...
回答  γ  - 21/5/11(火) 12:44 -

引用なし
パスワード
   こんな骨格のものにしたらよいのではないですか?
Sub test()
  Dim k As Long
  Dim r As Range
  
  For k = 1 To 11
    If Cells(2, k).Value = "休暇" Then
      For Each r In Union(Cells(4, k).Resize(7, 1), Cells(15, k).Resize(6, 1))
        'rセルの色が着いてなければ、黒にする。
      Next
    End If
  Next
End Sub
Unionを使わずに、繰り返しを二回書くことでもOKですが、
こうしておくと、色を処理するところが一カ所で済みます。
色をつけるところは、マクロ記録をよくみて検討してください。

なお、基本的な繰り返しが書けないようなら、
まずは教科書をよく読んだり、
その中に書いてあるコードを実際に手打ちして、
動作確認したりすることを優先してやったほうがよいと思います。
・ツリー全体表示

【81776】Re:セルの情報を取得し、任意のセルに色...
発言  そらお  - 21/5/11(火) 11:26 -

引用なし
パスワード
   先月から入門編の書籍を読み始めたところで、マクロの記録以外は出来ない状況です。おっしゃられている通り塗り潰しなどのコードは記録で取れます。コードも見れば何をしているかは何となく分かる感じにはなってきましたが、まだ何がわからないかが解らないような感じです。
自分の習熟を待ちたいのですが、効率を直ぐに上げたかったので質問させていただきました。
・ツリー全体表示

【81775】Re:セルの情報を取得し、任意のセルに色...
回答  γ  - 21/5/11(火) 5:52 -

引用なし
パスワード
   ご自分ではどこまで出来ていますか?
繰り返しの部分は普通にFor .. Nextループでよさそうですし、
塗りつぶし色の着脱はマクロ記録をとればコードが判明するはずです。
なにかしらコード作成に着手できるはずですが。(*)
できているところまでを示してもらえますか?

ただし、既存のセルの塗りつぶしが「条件付き書式」の場合は
少し工夫が必要です。
Excel2010以降であれば、DisplayFormatというプロパティが追加されていますので、
これを利用することになります。
ネットで検索してみてください。記事がたくさんあるはずです。

# (*)VBAを使えるようになるのが目的なら、ご自分でトライすることが有益です。
# どこが不明かを明確にしたうえで質問されることを推奨します。
# もし自分でするのが手間だからということでしたら勘弁下さい。
# いつまでも進歩はありません。(ゴメンネ朝から。でもこれを活かしてください)
・ツリー全体表示

【81774】セルの情報を取得し、任意のセルに色をつ...
質問  そらお  - 21/5/11(火) 0:46 -

引用なし
パスワード
   マクロを走らせ、特定の行のセルにデータを拾って、列の一部に色塗りをしたいのですが、
例えば、A2からK2でそこに"休暇"が入っていた場合、その列の4〜10行目と15〜20行目のセルに黒色を付けたい場合どのようにすればよろしいでしょうか。
後に任意で色を変える事があるため、条件付き書式設定では都合が悪いのでお力添えお願いします。
また、別で上記条件で色塗りする対象セルにその他の色が塗られていた場合、そこは色を変えないようにも出来ますでしょうか。
宜しくお願いします。
・ツリー全体表示

【81773】Re:コピペ高速化のコードについて(配列)
発言  やまた  - 21/5/10(月) 0:34 -

引用なし
パスワード
   yさん

ご回答ありがとうございます。

実行作業が行えておらず、実行次第ご返信致します。
・ツリー全体表示

【81772】Re:コピペ高速化のコードについて(配列)
回答  γ  - 21/5/9(日) 14:25 -

引用なし
パスワード
   Function copy2(rngFrom As Range, rngTo As Range)
  Dim v
  v = rngFrom.Value
  rngTo.Resize(UBound(v, 1), UBound(v, 2)) = v
End Function
と定義しておいて、

Call copy2(ws1.Range("AA157:AD256"),ws2.Range("H155"))
などとしてみてはどうですか?

今のコードでもセルを一つずつコピーしているわけではないから、
どの程度のスピードアップにつながるのかは不明だが。
(3割くらいにはなるのかも)

以下のようにして速度を測り、その結果をフィードバックしてください。
 dim t
 t = Timer
 ' ここで作業
 Debug.Print Timer - t '経過時間の出力

それから転記先に計算式が多いのであれば、
手動計算モードにしてから処理実行し、終了後、自動計算に戻すとよいでしょう。
今のコードでも効果あるかもしれません。

# なお、転記元、先に一定の規則性のようなものがありそうで、
# 記述の短縮が図られそうな気もするが、それには触れません。
・ツリー全体表示

【81771】コピペ高速化のコードについて(配列)
質問  やまた  - 21/5/8(土) 22:50 -

引用なし
パスワード
   コピペ高速化のコードについて


3つのシート(”反映作業1”、”反映作業2”、”反映作業3”)があり
”反映作業1”、”反映作業2”から”出力シート”に
”反映作業3”から”予定シート”に転記する際の
VBAコードについて教えていただけると幸いです。

現在、都度、シート間を移動してコピペをするコードのため
処理するのに数分かかってしまいます。

高速化のためにどうすればよいか調べ、配列を使用すれば
高速処理が可能になるだろう思い、配列について調べていたのですが
今の私には難しく、思っている作業を実現するコードが書けません。

お力添えいただけたらと思います。

行いたい作業は以下です。

”反映作業1”のシートのRange("AA157:AD256")をコピーして
”入力シート”のRange("H155")に値の貼り付け

”反映作業1”のシートのRange("AE157:AH256")をコピーして
”入力シート”のRange("N155")に値の貼り付け

”反映作業1”のシートのRange("AI157:AL256")をコピーして
”入力シート”のRange("T155")に値の貼り付け

”反映作業1”のシートのRange("AM157:AP256")をコピーして
”入力シート”のRange("Z155")に値の貼り付け

中略

”反映作業1”のシートのRange("BS157:BV256")をコピーして
”入力シート”のRange("BV155")に値の貼り付け

↓(”反映作業1”から”出力シート”へのコピペは計12回です)

”反映作業2”のシートのRange("AA157:AD256")をコピーして
”入力シート”のRange("H274")に値の貼り付け

”反映作業2”のシートのRange("AE157:AH256")をコピーして
”入力シート”のRange("N274")に値の貼り付け

”反映作業2”のシートのRange("AI157:AL256")をコピーして
”入力シート”のRange("T274")に値の貼り付け

”反映作業2”のシートのRange("AM157:AP256")をコピーして
”入力シート”のRange("Z274")に値の貼り付け

中略

”反映作業2”のシートのRange("BS157:BV256")をコピーして
”入力シート”のRange("BV274")に値の貼り付け

↓(”反映作業2”から”出力シート”へのコピペは計12回です)

”反映作業3”のシートのRange("AA157:AX166")から
”予定シート”のRange("B7")に値の貼り付け


あまりも長いので、行いたい作業を中略してしまいましたが
必要な情報でしたらご指摘ください。


どうぞよろしくお願いいたします。
・ツリー全体表示

【81770】Re:8桁数字(YYYYMMDD)の年月日の間に/...
お礼  V  - 21/5/6(木) 14:24 -

引用なし
パスワード
   ▼マナ さん:
>▼V さん:
>
>日付データではだめなのですか?
>
>Sub test()
>  Dim s As String
>  
>  s = "20210428"
>  MsgBox Format(s, "0000/00/00")
>  
>End Sub

マナさん

ありがとうございます!Formatでこのように指示するだけでよかったんですね!うまくいきそうで、とても助かりました^^
・ツリー全体表示

【81769】Re:8桁数字(YYYYMMDD)の年月日の間に/...
発言  マナ  - 21/4/30(金) 22:34 -

引用なし
パスワード
   ▼V さん:

日付データではだめなのですか?

Sub test()
  Dim s As String
  
  s = "20210428"
  MsgBox Format(s, "0000/00/00")
  
End Sub
・ツリー全体表示

【81768】Re:8桁数字(YYYYMMDD)の年月日の間に/...
回答  V  - 21/4/30(金) 11:31 -

引用なし
パスワード
   ▼マナ さん:
>▼V さん:
>
>手作業(区切り位置)で、簡単に日付データに変換できますが
>それではだめですか。

マナさん、ご返信ありがとうございます!今回、データダウンロードからエクセルデータのClean Up, ファイル変換して保存までの一連作業の自動化を検討中で、エクセル上の作業についてはマクロで設定し、その後はPower Automate上でマクロ実行を考えています。ちなみに8桁の数字は日付変換が出来ないフォーマットで、表示返還後も文字列として保存したいです。引き続きご教授よろしくお願いします!
・ツリー全体表示

【81767】Re:8桁数字(YYYYMMDD)の年月日の間に/...
発言  マナ  - 21/4/28(水) 21:43 -

引用なし
パスワード
   ▼V さん:

手作業(区切り位置)で、簡単に日付データに変換できますが
それではだめですか。
・ツリー全体表示

【81766】8桁数字(YYYYMMDD)の年月日の間に/スラ...
質問  V  - 21/4/28(水) 20:50 -

引用なし
パスワード
   はじめまして。ダウンロードデータの日付情報が8桁の数字(例:20210428)になっているのですが、年月日の間にスラッシュ/をいれて、2021/04/28 という文字列に変換し、その列の最後のデータまで繰り返したいのです。どなたかご教授ください!
・ツリー全体表示

【81765】Re:昨日以前の日付→明日へ変更する処理
回答  しん  - 21/4/28(水) 15:24 -

引用なし
パスワード
   こんな感じ

Sub tes01()
Dim tRng As Range
Dim R As Integer, endRow As Integer
'日付の最初のセル
Set tRng = Range("A3")
'下に続くセル数
endRow = tRng.End(xlDown).Row - tRng.Row
For R = 0 To endRow
 If tRng.Offset(R, 0).Value <= Date Then 'セルの日付が今日以前の場合
  tRng.Offset(R, 0).Value = Date + 1   'セルの明日の日付にする
 End If
Next

End Sub
・ツリー全体表示

【81764】Re:昨日以前の日付→明日へ変更する処理
回答  山内  - 21/4/28(水) 13:59 -

引用なし
パスワード
   Worksheet_Chageイベントでできると思います
Targetの値と今日の日付を比較して値を書き換えるだけですね
・ツリー全体表示

36 / 3841 ページ ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free