Excel VBA質問箱 IV

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

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


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

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

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

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

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


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, ",") 'カンマ区切りで配列へ
    
    '*** 必要なデータのみ読み込む 2列目がなごやのデータ
    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
・ツリー全体表示

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

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

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

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

【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 さん:

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

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