Excel VBA質問箱 IV

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

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


1061 / 13644 ツリー ←次へ | 前へ→

【76525】コードを短くしたい ゆーあ 14/12/26(金) 15:42 発言[未読]
【76526】Re:コードを短くしたい β 14/12/26(金) 17:54 発言[未読]
【76527】Re:コードを短くしたい ゆーあ 14/12/26(金) 21:10 発言[未読]
【76528】Re:コードを短くしたい β 14/12/26(金) 22:33 発言[未読]
【76529】Re:コードを短くしたい β 14/12/26(金) 22:38 発言[未読]
【76530】Re:コードを短くしたい ゆーあ 14/12/27(土) 11:37 発言[未読]
【76531】Re:コードを短くしたい β 14/12/27(土) 12:34 発言[未読]
【76532】Re:コードを短くしたい ゆーあ 14/12/27(土) 13:35 発言[未読]
【76533】Re:コードを短くしたい β 14/12/27(土) 16:22 発言[未読]
【76534】Re:コードを短くしたい ゆーあ 14/12/27(土) 17:57 発言[未読]
【76535】Re:コードを短くしたい ゆーあ 14/12/29(月) 11:07 発言[未読]
【76536】Re:コードを短くしたい ゆーあ 14/12/29(月) 11:30 発言[未読]
【76537】Re:コードを短くしたい γ 14/12/29(月) 12:03 発言[未読]
【76538】Re:コードを短くしたい ゆーあ 14/12/29(月) 13:19 発言[未読]
【76539】Re:コードを短くしたい β 14/12/29(月) 15:08 発言[未読]
【76541】Re:コードを短くしたい ゆーあ 14/12/29(月) 18:19 発言[未読]
【76542】Re:コードを短くしたい β 14/12/29(月) 19:41 発言[未読]
【76543】Re:コードを短くしたい ゆーあ 14/12/30(火) 9:00 お礼[未読]
【76540】Re:コードを短くしたい γ 14/12/29(月) 15:18 発言[未読]

【76525】コードを短くしたい
発言  ゆーあ  - 14/12/26(金) 15:42 -

引用なし
パスワード
   WinXP Excel2000

顧客情報のデータベースとして使用しているファイルがあり、
フォーム上で情報の登録/変更/削除を行っております。

フォーム上に表示されている情報を印刷する時、
印刷ボタン(フォーム上に印刷用コマンドボタンを配置)を押して、
フォーム自体(PrintFormを使用)を印刷しておりました。

しかし、PrintFormでは、印刷設定が出来ず、
また複数人が使用する為、不具合が生じておりましたので、
フォーム表示上の情報を、新規ブックに転記する方法に変更しました。

新規ブックへの転記コード自体は問題無く出来たのでですが、
転記する情報量が多い為か、単純にコードが長い為か、
(どちらもかも)作業完了までかなりの時間を有しております。

転記コードの流れとして、
1.新規ブック立上げ
2.新規ブックに罫線で表を作成
3.新規ブック表に各項目名を入力
4.データベースファイルから新規ブックへ転記
5.新規ブックのフォント等調整変更
をしております。

やっと本題ですが、
4.データベースファイルから新規ブックへの転記
のコードが、現状1つずつコピーして貼り付けるようになってますので、
そのコードを短くできないかと考えております。
下記に抜粋ですが、コードを示しますので。
アドバイス等頂ければ幸いです。宜しくお願い致します。


  Windows(exiWB).Activate  'データベースファイル選択
  Worksheets("Sheet3").Activate 
  Sheets("Sheet3").Cells(ActiveCell.Row, 1).Select
  Selection.Copy
  Windows(NewWB).Activate  '新規ブック選択
  Sheets("データ抽出").Range("B6").Select
  Selection.PasteSpecial Paste:=xlValues
          ・
          ・
          ・
          ・
  Windows(exiWB).Activate
  Worksheets("Sheet3").Activate
  Sheets("Sheet3").Cells(ActiveCell.Row, 50).Select
  Selection.Copy
  Windows(NewWB).Activate
  Sheets("データ抽出").Range("H51").Select
  Selection.PasteSpecial Paste:=xlValues


データベースファイルのセルセレクトは、順番(1〜50)ですが、
新規ブックの方は、規則性はあるもののランダムになってます。
 B6/C6/D6/E6/H6,B11/C11/D11/E11/H11,B16/C16/D16/E16/H16
 B21/C21/D21/E21/H21,B26/C26/D26/E26/H26,B31/C31/D31/E31/H31
 B36/C36/D36/E36/H36,B41/C41/D41/E41/H41,B46/C46/D46/E46/H46
 B51/C51/D51/E51/H51

【76526】Re:コードを短くしたい
発言  β  - 14/12/26(金) 17:54 -

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

コードはよく読んでいませんが、1項目ごとに

・元ブックをActiveにして
・そこの項目をコピーして
・新ブックをアクティブにして
・書き込みセルを選択して
・ペースト

これでは時間がかかるでしょうね。

>データベースファイルのセルセレクトは、順番(1〜50)ですが、
>新規ブックの方は、規則性はあるもののランダムになってます。

これについても、整理してコードを短くすることができますが、その前に
まずは、上記の状態を改善するところから始められてはいかがでしょう。

Sub Sample()
  Dim dBK As Workbook
  Dim nBK As Workbook
  Dim dSh As Worksheet
  Dim nSh As Worksheet
  
  Set dBK = Workbooks("●●●●.xls")
  Set dSh = dBK.Sheets("Sheet3")
  Set nBK = Workbooks("□□□□.xls")
  Set nSh = nBK.Sheets("データ抽出")
  
  Application.ScreenUpdating = False   'セル書き込みに伴う画面再描画の抑止(処理時間の短縮化)
  
  nSh.Range("B6").Value = dSh.Range("A1").Value
  nSh.Range("C6").Value = dSh.Range("A2").Value
  nSh.Range("D6").Value = dSh.Range("A3").Value
  
      '
      '
      '
      
End Sub

【76527】Re:コードを短くしたい
発言  ゆーあ  - 14/12/26(金) 21:10 -

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

コメントありがとうございます。
ご説明不足で大変申し訳ございませんが、
現状、データベースのブックと新規ブックを下記の用に宣言しており、
流用しようとしましたが、私の力量では無理でした。。。

Dim exiWB As String
Dim NewWB As String
Dim A As Workbook
Dim C As Workbook

Set A = ThisWorkbook
exiWB = ThisWorkbook.Name
Set C = Workbooks.Add(Template:=xlWBATWorksheet)
NewWB = ActiveWorkbook.Name
ActiveWorkbook.Sheets("Sheet1").Name = "データ抽出"

【76528】Re:コードを短くしたい
発言  β  - 14/12/26(金) 22:33 -

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

それでは、先ほどアップしたSaampleに、追加で書いてもらったコード要件を
カミして再掲。ただし、転記コードは3行しか書いてません。残りの47行は
そちらで追加して完成させてください。

で、これでもいいと思いますが、【コードを整理して短く】した Sample2 も
あわせてアップいます。コードも短くしていますが、5セル1セットの転記、
Sampleのほうではコードも5行(つまりセルに5回書き込み)あるのですが
Sample2では2行(つまりせるにへの書き込み回数は1セット2回)にしています。

まず、Sample を自分のものとして理解したのちに Sample2 に取り組んでください。

Sub Sample()
  '元ブックと元シート
  Dim dBK As Workbook
  Dim dSh As Worksheet
  '転記ブックと転記シート
  Dim nBK As Workbook
  Dim nSh As Worksheet
  
  Set dBK = ThisWorkbook
  Set dSh = dBK.Sheets("Sheet3")
  
  Set nBK = Workbooks.Add(xlWBATWorksheet)
  Set nSh = nBK.Sheets(1)
  nSh.Name = "データ抽出"
  
  Application.ScreenUpdating = False   'セル書き込みに伴う画面再描画の抑止(処理時間の短縮化)
  
  nSh.Range("B6").Value = dSh.Range("A1").Value
  nSh.Range("C6").Value = dSh.Range("A2").Value
  nSh.Range("D6").Value = dSh.Range("A3").Value
  
      '
      '省略 ゆーあさんのほうで、コードを追加して完成させてください
      '
      
End Sub

Sub Sample2()
  Dim i As Long
  Dim j As Long
  '元ブックと元シート
  Dim dBK As Workbook
  Dim dSh As Worksheet
  '転記ブックと転記シート
  Dim nBK As Workbook
  Dim nSh As Worksheet
  
  Set dBK = ThisWorkbook
  Set dSh = dBK.Sheets("Sheet3")
  
  Set nBK = Workbooks.Add(xlWBATWorksheet)
  Set nSh = nBK.Sheets(1)
  nSh.Name = "データ抽出"
  
  Application.ScreenUpdating = False
  
  j = 6
  For i = 1 To 46 Step 5
    nSh.Cells(j, "B").Resize(, 4).Value = WorksheetFunction.Transpose(dSh.Cells(i, "A").Resize(4).Value)
    nSh.Cells(j, "H").Value = dSh.Cells(i + 4, "A").Value
    j = j + 5
  Next
  
End Sub

【76529】Re:コードを短くしたい
発言  β  - 14/12/26(金) 22:38 -

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

追伸です。
xl2000の環境がないので、
Set nBK = Workbooks.Add(xlWBATWorksheet)
ここがちょっと不安です。(Add と Set を同時にできたかどうか)
不具合があればAddとSetをわけますので連絡願います。

【76530】Re:コードを短くしたい
発言  ゆーあ  - 14/12/27(土) 11:37 -

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

こんにちはです。
コード作成頂き、誠にありがとうございます。

早速、Sampleの方を試してみました。
元ブックのActiveCellを読んでくる必要がある為、
コードを、
  nSh.Range("B6").Value = dSh.Cells(ActiveCell.Row, 1).Value
に変更しましたが、上手く動作しませんでした。。。

データベースとして使用している元ブックは、
各データを行で一つのグループとして分けており、
フォーム上の↓↑で、行を移動させ、フォーム上に表示させております。
したがって、元ブックのActiveCellがある行のデータを新規ブックに
転記させようと思ったのですが、変更したコードでは駄目でした。

どのように変更(取得)してやればよいのでしょうか?

【76531】Re:コードを短くしたい
発言  β  - 14/12/27(土) 12:34 -

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

最初に提示いただいたコードを良く読んでいませんでした。
私がアップしたコードでは、、元ブックからの抽出がA1,A2,A3,A4・・・
としていましたが、そうじゃなかったんですね。

実行時に選択されていたセルの行の A●,B●,C●,D●,・・・・
なんですね。

この理解が正しければ、修正したSampleとSample2を再掲しますので
確認願います。

【76532】Re:コードを短くしたい
発言  ゆーあ  - 14/12/27(土) 13:35 -

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

コメントありがとうございます。
またまた私の説明不足で申し訳ございません。
最初にもっと分かりやすく説明するべきでした。。。

ですがお陰様で、
ご提示頂いたコードを調べることで勉強にはなってますので、
大変感謝しております。

理解の正否については、仰る通り、
実行時に選択されていたセル行ご認識で問題ございません。
お手数お掛けして申し訳ございませんが、宜しくお願い致します。

【76533】Re:コードを短くしたい
発言  β  - 14/12/27(土) 16:22 -

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

それでは、コードを3つアップします。

その前に、

ActiveCell や Selection や ActiveSheet や ActiveWorkbook を前提にした
コードは極力避けることが推奨されます。
VBAコードでは、これらを前提にしなくても(99.9%ぐらいは)ブックやシートやセルを特定できます。
もちろん、ActiveCell というものは、ActiveSheet上にしかなく、また、ほかのコードの書き方では
参照できない、そんなものもあるにはありますが、これらは例外です。

今後、デバッグ等の目的でステップ実行しながら処理の途中経過を確認していく、そういった作業の中で
裏に隠れていたブックを確認したり、裏に隠れていたシートを確認したりするでしょう。
で、確認後、ステップ実行を継続すると、ActiveWorkbookが本来のものとは異なっていたり、あるいは
ActiveSheetが本来のものとは異なっていたり、そんなことが往々にして発生し、とんでもない障害になる
可能性があります。

ですから、コード内では、極力、今相手にしているブック、シート、セルを特定して記述することが
重要です。

前置きは以上。

SampleA が すでにアップした Sample に相当します。
1項目ごとに転記コードを書いたものです。
でも、そちらで、今使っているコード(2つのブックを1項目ごとにアクティブにして処理するコード)
より、数段早いはずです。

SampleB は、基本的には SampleA と同じ発想です。
ただ、元データの連続した4列(4セル)を新データの連続した4列(4セル)に転記するところを
1行で、(1セルの転記ではなく)4セル領域の転記として書いています。
コードも短くなりますし、セルへの書き込み回数も減少しますので、SampleA より処理効率がアップします。

で、今回のデータから見て、この SampleB で十分だと思いますが、参考までに、SampleB での転記を
ループさせて書き込むコードを SampleC としてアップします。
コード数は少なくなりますが、実は、処理効率としては SampleB と同じか、ループ制御のための処理で
ほんのわずか、効率が落ちるかも。

ただ、ループ処理の1つの例として参考までにお届けします。

Sub SampleA()
  Dim i As Long
  '元ブックと元シート
  Dim dBK As Workbook
  Dim dSh As Worksheet
  '転記ブックと転記シート
  Dim nBK As Workbook
  Dim nSh As Worksheet
'--------------------------------------------
  Set dBK = ThisWorkbook
  Set dSh = dBK.Sheets("Sheet3")
  
  'Just In Case
  If Not ActiveSheet Is dSh Then
    MsgBox dSh.Name & "をアクティブにしてから実行してください"
    Exit Sub
  End If
  
  Application.ScreenUpdating = False   'セル書き込みに伴う画面再描画の抑止(処理時間の短縮化)
  
  i = ActiveCell.Row   '抽出すべき行番号
  Set nBK = Workbooks.Add(xlWBATWorksheet)
  Set nSh = nBK.Sheets(1)
  nSh.Name = "データ抽出"
  
  nSh.Range("B6").Value = dSh.Cells(i, 1).Value
  nSh.Range("C6").Value = dSh.Cells(i, 2).Value
  nSh.Range("D6").Value = dSh.Cells(i, 3).Value
  nSh.Range("E6").Value = dSh.Cells(i, 4).Value
  nSh.Range("H6").Value = dSh.Cells(i, 5).Value
  nSh.Range("B11").Value = dSh.Cells(i, 6).Value
  nSh.Range("C11").Value = dSh.Cells(i, 7).Value
  nSh.Range("D11").Value = dSh.Cells(i, 8).Value
  nSh.Range("E11").Value = dSh.Cells(i, 9).Value
  nSh.Range("H11").Value = dSh.Cells(i, 10).Value
  nSh.Range("B16").Value = dSh.Cells(i, 11).Value
  nSh.Range("C16").Value = dSh.Cells(i, 12).Value
  nSh.Range("D16").Value = dSh.Cells(i, 13).Value
  nSh.Range("E16").Value = dSh.Cells(i, 14).Value
  nSh.Range("H16").Value = dSh.Cells(i, 15).Value
  nSh.Range("B21").Value = dSh.Cells(i, 16).Value
  nSh.Range("C21").Value = dSh.Cells(i, 17).Value
  nSh.Range("D21").Value = dSh.Cells(i, 18).Value
  nSh.Range("E21").Value = dSh.Cells(i, 19).Value
  nSh.Range("H21").Value = dSh.Cells(i, 20).Value
  nSh.Range("B26").Value = dSh.Cells(i, 21).Value
  nSh.Range("C26").Value = dSh.Cells(i, 22).Value
  nSh.Range("D26").Value = dSh.Cells(i, 23).Value
  nSh.Range("E26").Value = dSh.Cells(i, 24).Value
  nSh.Range("H26").Value = dSh.Cells(i, 25).Value
  nSh.Range("B31").Value = dSh.Cells(i, 26).Value
  nSh.Range("C31").Value = dSh.Cells(i, 27).Value
  nSh.Range("D31").Value = dSh.Cells(i, 28).Value
  nSh.Range("E31").Value = dSh.Cells(i, 29).Value
  nSh.Range("H31").Value = dSh.Cells(i, 30).Value
  nSh.Range("B36").Value = dSh.Cells(i, 31).Value
  nSh.Range("C36").Value = dSh.Cells(i, 32).Value
  nSh.Range("D36").Value = dSh.Cells(i, 33).Value
  nSh.Range("E36").Value = dSh.Cells(i, 34).Value
  nSh.Range("H36").Value = dSh.Cells(i, 35).Value
  nSh.Range("B41").Value = dSh.Cells(i, 36).Value
  nSh.Range("C41").Value = dSh.Cells(i, 37).Value
  nSh.Range("D41").Value = dSh.Cells(i, 38).Value
  nSh.Range("E41").Value = dSh.Cells(i, 39).Value
  nSh.Range("H41").Value = dSh.Cells(i, 40).Value
  nSh.Range("B46").Value = dSh.Cells(i, 41).Value
  nSh.Range("C46").Value = dSh.Cells(i, 42).Value
  nSh.Range("D46").Value = dSh.Cells(i, 43).Value
  nSh.Range("E46").Value = dSh.Cells(i, 44).Value
  nSh.Range("H46").Value = dSh.Cells(i, 45).Value
  nSh.Range("B51").Value = dSh.Cells(i, 46).Value
  nSh.Range("C51").Value = dSh.Cells(i, 47).Value
  nSh.Range("D51").Value = dSh.Cells(i, 48).Value
  nSh.Range("E51").Value = dSh.Cells(i, 49).Value
  nSh.Range("H51").Value = dSh.Cells(i, 50).Value
  
     
End Sub


Sub SampleB()
  Dim i As Long
  '元ブックと元シート
  Dim dBK As Workbook
  Dim dSh As Worksheet
  '転記ブックと転記シート
  Dim nBK As Workbook
  Dim nSh As Worksheet
'--------------------------------------------
  Set dBK = ThisWorkbook
  Set dSh = dBK.Sheets("Sheet3")
  
  'Just In Case
  If Not ActiveSheet Is dSh Then
    MsgBox dSh.Name & "をアクティブにしてから実行してください"
    Exit Sub
  End If
  
  Application.ScreenUpdating = False   'セル書き込みに伴う画面再描画の抑止(処理時間の短縮化)
  
  i = ActiveCell.Row   '抽出すべき行番号
  Set nBK = Workbooks.Add(xlWBATWorksheet)
  Set nSh = nBK.Sheets(1)
  nSh.Name = "データ抽出"
  
  nSh.Range("B6").Resize(, 4).Value = dSh.Cells(i, 1).Resize(, 4).Value
  nSh.Range("H6").Value = dSh.Cells(i, 5).Value
  nSh.Range("B11").Resize(, 4).Value = dSh.Cells(i, 6).Resize(, 4).Value
  nSh.Range("H11").Value = dSh.Cells(i, 10).Value
  nSh.Range("B16").Resize(, 4).Value = dSh.Cells(i, 11).Resize(, 4).Value
  nSh.Range("H16").Value = dSh.Cells(i, 15).Value
  nSh.Range("B21").Resize(, 4).Value = dSh.Cells(i, 16).Resize(, 4).Value
  nSh.Range("H21").Value = dSh.Cells(i, 20).Value
  nSh.Range("B26").Resize(, 4).Value = dSh.Cells(i, 21).Resize(, 4).Value
  nSh.Range("H26").Value = dSh.Cells(i, 25).Value
  nSh.Range("B31").Resize(, 4).Value = dSh.Cells(i, 26).Resize(, 4).Value
  nSh.Range("H31").Value = dSh.Cells(i, 30).Value
  nSh.Range("B36").Resize(, 4).Value = dSh.Cells(i, 31).Resize(, 4).Value
  nSh.Range("H36").Value = dSh.Cells(i, 35).Value
  nSh.Range("B41").Resize(, 4).Value = dSh.Cells(i, 36).Resize(, 4).Value
  nSh.Range("H41").Value = dSh.Cells(i, 40).Value
  nSh.Range("B46").Resize(, 4).Value = dSh.Cells(i, 41).Resize(, 4).Value
  nSh.Range("H46").Value = dSh.Cells(i, 45).Value
  nSh.Range("B51").Resize(, 4).Value = dSh.Cells(i, 46).Resize(, 4).Value
  nSh.Range("H51").Value = dSh.Cells(i, 50).Value
  
     
End Sub

Sub SampleC()
  Dim i As Long
  Dim j As Long
  Dim x As Long
  '元ブックと元シート
  Dim dBK As Workbook
  Dim dSh As Worksheet
  '転記ブックと転記シート
  Dim nBK As Workbook
  Dim nSh As Worksheet
  
  Set dBK = ThisWorkbook
  Set dSh = dBK.Sheets("Sheet3")
  
  'Just In Case
  If Not ActiveSheet Is dSh Then
    MsgBox dSh.Name & "をアクティブにしてから実行してください"
    Exit Sub
  End If
  
  Application.ScreenUpdating = False
  
  i = ActiveCell.Row   '抽出すべき行番号
  Set nBK = Workbooks.Add(xlWBATWorksheet)
  Set nSh = nBK.Sheets(1)
  nSh.Name = "データ抽出"
  
  j = 6
  For x = 1 To 46 Step 5
    nSh.Cells(j, "B").Resize(, 4).Value = dSh.Cells(i, x).Resize(, 4).Value
    nSh.Cells(j, "H").Value = dSh.Cells(i, x + 4).Value
    j = j + 5
  Next
  
End Sub

【76534】Re:コードを短くしたい
発言  ゆーあ  - 14/12/27(土) 17:57 -

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

コメントありがとうございます。
ちょっと(かなり)こんがらがってきました。。。

今バタバタしておりますので、
来週頭に改めて返信させて頂きます。すみません。。。

【76535】Re:コードを短くしたい
発言  ゆーあ  - 14/12/29(月) 11:07 -

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

おはようございます。
返信遅くなり、申し訳御座いません。

早速ですが、
まず、
>ActiveCell や Selection や ActiveSheet や ActiveWorkbook を前提にした
>コードは極力避けることが推奨されます。
>ActiveSheetが本来のものとは異なっていたり、そんなことが往々にして発生し、
>とんでもない障害になる可能性があります。
とのことですが、
   Sheets("Sheet3").Cells(ActiveCell.Row, 1).Select
のことを仰ってるでしょうか?
その場合、別件ですがご相談させて頂きたいです。。。

先日、データベースとして使用している元ブックは、
各データを行で一つのグループに分けていると説明したと思いますが、
元ブックのSheet構成として、
 Sheet1:フォーム呼出ボタンのみ(sheet表示)
 Sheet2:個人データ登録用シート(非表示)
 Sheet3:(各個人データ)データシート1(非表示)
 Sheet4:(各個人データ)データシート2(非表示)
としており、
操作(登録/更新/削除)は全て、フォーム(個人データ)上で行っております。
フォーム(個人データ)上に、データシート1&2フォーム呼出のコマンドボタンを
設置しており、
フォーム(個人データ)より別フォームを立ち上げて、データを登録
する様にしております。

Sheet2
  A  B  C   D   ・・・
1 名前 年齢 住所 電話番号 ・・・
2 田中 30 ・・・
3 佐藤 40 ・・・
4 小林 50 ・・・

Sheet3
   A   B  C   D   E   F   G  H  
1 依頼日1 受付1 対応1 内容1 依頼2 受付2 対応2 内容2・・・
2  1/1  山田 ・・・
3  2/1  富樫 ・・・
4  3/1  葉山 ・・・

Sheet4
   A   B    C   D   E   F   G   H  
1 依頼日51 受付51 対応51 内容51 依頼52 受付52 対応52 内容52・・・
2  5/1   富樫 ・・・
3  6/1   葉山 ・・・
4  7/1   山田 ・・・

Sheet3の連番でSheet4に続きます。
どのSheetも2行目は、田中のデータとなり、3行目は、佐藤のデータとなります。

やっと本題ですが、
Sheet2の氏名位置を基に、各シートのデータ管理を行っているのですが、

  Dim 氏名 As Range
  Dim AAA As String
  Set 氏名 = Worksheets("Sheet2").Cells(ActiveCell.Row, 1)
  AAA = 氏名.Address(False, False)

頻繁に、ActiveCellなど使用してますので、
現状の管理方法では、とんでもない障害が起こりえるでしょうか??


次に、ご提示頂いたコードについてですが、
SampleAで動作確認したところ、
"Sheet3をアクティブにしてから実行して下さい"
と言われてしまいました。
アクティブになるように試してみましたが、ダメでした。

よってSampleBでも同様の現象が起こると思ったので、
SampleBを使って、
  Windows(exiWB).Activate
  Worksheets("Sheet3").Activate
  Sheets("Sheet3").Cells(ActiveCell.Row, 1).Resize(, 4).Select
  Selection.Copy
  Windows(NewWB).Activate
  Sheets("データ抽出").Range("B6").Resize(, 4).Select
  Selection.PasteSpecial Paste:=xlValues
  
  Windows(exiWB).Activate
  Worksheets("Sheet3").Activate
  Sheets("Sheet3").Cells(ActiveCell.Row, 5).Select
  Selection.Copy
  Windows(NewWB).Activate
  Sheets("データ抽出").Range("H6").Select
  Selection.PasteSpecial Paste:=xlValues

に改良してみました、
C〜E列の記載が無くなった分、早くなった気がしますがどうでしょうか?
宜しくお願い致します。

【76536】Re:コードを短くしたい
発言  ゆーあ  - 14/12/29(月) 11:30 -

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

SampleCを使っての改良もしてみました。
もっと早くなった気がします!!

  j = 6
  For x = 1 To 46 Step 5
  Windows(exiWB).Activate
  Worksheets("Sheet3").Activate
  Sheets("Sheet3").Cells(ActiveCell.Row, x).Resize(, 4).Select
  Selection.Copy
  Windows(NewWB).Activate
  Sheets("データ抽出").Range("B" & j).Resize(, 4).Select
  Selection.PasteSpecial Paste:=xlValues
  Windows(exiWB).Activate
  Worksheets("Sheet3").Activate
  Sheets("Sheet3").Cells(ActiveCell.Row, x + 4).Select
  Selection.Copy
  Windows(NewWB).Activate
  Sheets("データ抽出").Range("H" & j).Select
  Selection.PasteSpecial Paste:=xlValues
  j = j + 5
  Next

【76537】Re:コードを短くしたい
発言  γ  - 14/12/29(月) 12:03 -

引用なし
パスワード
   横から失礼します。# 殆ど同じ指摘かもしれませんが、あえて。

Sheetを逐一アクティブにしたり、Selectを頻繁に行うのは、
速度的な効率が悪い上に、コードの可読性(判りやすさ、簡潔性)を
損ないます。実は後者のほうがより重要かなと考えています。

また、
・Bookがアクティブでなければ、Sheetが選択できない(エラーになる)
・Sheetがアクティブでなければ、セルを選択できない(エラーになる)と
いったことに注意を払わなければならりません。
さらに、単にActiveCellと書くと、別のシートのそれを誤って引用する懼れもあります。
一度、対応するSheetを確認したうえで、Range変数にセットして、
その変数を使い回すほうがよいでしょう。

今は表面上問題化しなくても、リスクを抱えた書き方ではないかと思います。
できるだけこれらに依存しない書き方を採用するのがよいでしょうし、
皆さん、そうされていますよ。(日本人にはこういう言い方が有効らしいです。)


[無駄なSelectをしない]
ht tp://officetanaka.net/excel/vba/speed/s2.htm
などを参考にして下さい。

【76538】Re:コードを短くしたい
発言  ゆーあ  - 14/12/29(月) 13:19 -

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

コメントありがとうごいます。
仰っておられるのは、
  Windows(exiWB).Activate
  Worksheets("Sheet3").Activate
  Sheets("Sheet3").Cells(ActiveCell.Row, x).Resize(, 4).Select
  Selection.Copy
ですよね?
私も逐一アクティブにしたり、セレクトしたくないので、
短くしようとしたのですが、ことごとく失敗してます。。。

たとえば、
    Worksheets("Sheet3").Activate
を抜いてみたりもしたのですが、抜くと上手く動作しないんです。


申し訳御座いませんが、具体的に
>一度、対応するSheetを確認したうえで、Range変数にセットして、
>その変数を使い回すほうがよいでしょう。
とはどのように記述したら良いのでしょうか?
私もリスクを抱えた書き方では無い方法が良いと思いますので、
お手数お掛け致しますが、お教え頂ければ幸いで御座います。

【76539】Re:コードを短くしたい
発言  β  - 14/12/29(月) 15:08 -

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

γさんから、貴重なアドバイスがでています。
紹介されたOfficeTANAKAサイトの記載もよく読んでみてください。

私も、具体的なテーマからちょっと離れて。

「SampleBを使って・・・改良してみました。」
「SampleCを使っての改良もしてみました。」

と書いておられますが、実際に示していただいた「改良コード」は
もともとの、ゆーあさんのコーディングスタイルのままです。
ゆーあさんのコードは値の転記を、Copy-->PasteSpecial(xlValue) で行っていましたね。
それを実現するためにSheetのSelectや、セルのSelectも記述してあったわけです。

で、SampleA は、それを、

転記先セル.Value = 転記元セル.Value

という、ある意味、VBAスタンダードの記述方式に変えたものです。

次に、SampleB は 1項目ごとの転記(つまり転記すべきセル数だけ、転記コードが必要)
から、「連続した領域」を一挙に転記(コードは1行ですみます)するために

転記先セル【群】.Value = 転記元セル【群】.Value

に変更して、コード数を少なくし、コード数が少ないということは、実行回数も少ないので
処理効率のアップも図ったものです。

最後に、SampleC は、短くなったとはいえ、SampleB で、同じような規則性で処理されている
部分を変数を使ったループ処理として記述。コード数を減少させえています。

別のポイントで。

VBAでセルを特定する場合、「このブック」の「このシート」の「このセル」と書きます。
「このブック」が省略されれば、今アクティブなブックというようになります。
「このシート」が省略されれば、今アクティブなシートとみなされます。
(いずれも標準モジュールでの話ですが)
なので、ゆーあさんは「このセル」という表現だけで処理ができるように
処理対象のブックをアクティブにし、処理対象のシートをアクティブにしているわけですね。

でも、私が提示したコードでは、ブックのアクティブもシートのアクティブも行っていない。
だけど、処理はできたはずです。そこのところを、じっくりと考えてみてください。

あるセルの値を、別シートのセルに転記する操作をマクロ記録しますと

Sub Macro1()
  Sheets("Sheet1").Select
  Range("A1").Select
  Selection.Copy
  Sheets("Sheet3").Select
  Range("E9").Select
  Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
End Sub

こんなコードが生成されますね。

で、これと同じことをしようと以下のコードを書いたとします。

Sub TestNG1()
  Range("A1").Select
  Selection.Copy
  Range("E9").Select
  Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
End Sub

シートのSelectをなくしたものでエス。
でも、これでは最初のA1がどこのシートのA1なのか、ちょっと心細い記述ですね。
何よりも、E9 は、A1と同じシートになってしまいますね。具合悪いですね。

ということで

Sub TestNG2()
  Sheets("Sheet1").Range("A1").Select   '★シートを特定
  Selection.Copy
  Sheets("Sheet3").Range("E9").Select   '★でも、ここでエラー
  Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
End Sub

こんなように、セルがどのシートなのかを特定しました。
でも、E9 の Select でエラーになります。
セル.Select は、そのセルがアクティブシートにある場合のみOKで、そうでなければエラー。

なんとかしたいということで

Sub TestOK1() '★シートとセルを特定してコピーペースト
  Sheets("Sheet1").Range("A1").Copy
  Sheets("Sheet3").Range("E9").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
End Sub

あぁ、これでうまくいきました。
でも、Copy->PasteSpecialですから22のコードが必要ですね。

Sub TestOK2()
  Sheets("Sheet1").Range("A1").Copy Sheets("Sheet3").Range("E9")
End Sub

あぁ、これで1行でできました。
でも、仮にA1に書式設定があればあそれごとコピーされます。値の転記であれば

Sub TestOK3()
  Sheets("Sheet3").Range("E9").Value = Sheets("Sheet1").Range("A1").Value
End Sub

一般にはこのように書くわけです。

消化不良になるかも?なので、これぐらいでやめます。
ここでコメントしたことを念頭に、もう一度、SampleA,SampleB,SampleC を眺めてください。

【76540】Re:コードを短くしたい
発言  γ  - 14/12/29(月) 15:18 -

引用なし
パスワード
   >   Dim 氏名 As Range
>   Dim AAA As String
>   Set 氏名 = Worksheets("Sheet2").Cells(ActiveCell.Row, 1)
>   AAA = 氏名.Address(False, False)
>
> 頻繁に、ActiveCellなど使用してますので、
> 現状の管理方法では、とんでもない障害が起こりえるでしょうか??
すべての発言を読んでいるわけではないのですが、
上記のコードをみて ActiveCellの属するシートが心配になったのでした。

ところで、
>   Windows(exiWB).Activate
>   Worksheets("Sheet3").Activate
>   Sheets("Sheet3").Cells(ActiveCell.Row, 1).Resize(, 4).Select
>   Selection.Copy
>   Windows(NewWB).Activate
>   Sheets("データ抽出").Range("B6").Resize(, 4).Select
>   Selection.PasteSpecial Paste:=xlValues
>   
>   Windows(exiWB).Activate
>   Worksheets("Sheet3").Activate
>   Sheets("Sheet3").Cells(ActiveCell.Row, 5).Select
>   Selection.Copy
>   Windows(NewWB).Activate
>   Sheets("データ抽出").Range("H6").Select
>   Selection.PasteSpecial Paste:=xlValues
は、例えば以下のように書けるでしょう。

  Dim sWs As Worksheet
  Dim dWs As Worksheet
  Dim r As Long

  Windows(exiWB).Activate
  Worksheets("Sheet3").Activate
  r = ActiveCell.Row

  Set sWs = Workbooks(exiWB).Sheets("Sheet3")
  Set dWs = Workbooks(NewWB).Sheets("データ抽出")

  sWs.Cells(r, 1).Resize(, 4).Copy
  dWs.Range("B6").Resize(, 4).PasteSpecial Paste:=xlValues

  sWs.Cells(r, 5).Copy
  dWs.Range("H6").PasteSpecial Paste:=xlValues
  ・・・以下略 ・・・

こんな感じです。
何度も ActiveCellと連呼せずに、一度定義した r を使い回すと、
逆にそれが変動しているかどうか心配する必要がありません。

これをもっと簡略化したのが、
βさんの ,Valueプロパティに直接書き込む方式です。
すでに、βさんのものがありますから、それを参考にしてください。

# 文章作成後に βさんの投稿があることを知りました。
# たぶん重複しているかと思いますが、あえて追記しておきます。

【76541】Re:コードを短くしたい
発言  ゆーあ  - 14/12/29(月) 18:19 -

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

ご指導頂きありがとうございます。
また勝手なことばかりして、すみません。。。


SampleAを実行すると、
「Sheet3をアクティブにして下さい」
と動作ストップするので、
アクティブにするには?と考えていろいろ試してたのですが、
上手くアクティブにならず、私のなかで唯一アクティブになるコードが、
  Windows(exiWB).Activate
  Worksheets("Sheet3").Activate
でしたので、元のコードに戻った次第でした。。。


っで再度SampleAを眺めてみました。
流れは解る(なんとなくですが)のですが、
やはり実行すると何故か「アクティブにして下さい」と言われます。。。
それで、この文を、
  If Not ActiveSheet Is dSh Then
    MsgBox dSh.Name & "をアクティブにしてから実行してください"
    Exit Sub
  End If
消してみました。
すると、ちゃんと動作を行いました。

ここで、元ブックのSheet3をアクティブにしてるから実行するというのは、
なぜ必要なのでしょうか?

【76542】Re:コードを短くしたい
発言  β  - 14/12/29(月) 19:41 -

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

「Sheet3をアクティブにして下さい」
このメッセージは、エクセルやVBAではなく、このマクロで出しています。
決して、プログラムを直してくださいというメッセージではないんです。

マクロ処理を開始する時点でのデータシート(Sheet3) で選ばれているセルの行
のデータを転記先シートに転記しますよね。
ですから、どこが選ばれているかを把握しなきゃいけないんですが、このセル
(ActiveCell) を参照しようとした場合、必ずこのシートがアクティブになっている
必要があります。

想定としては、データシートをゆーあさんがアクティブにして、目的の行を選んで
マクロ実行。
こう考えているんですが、このメッセージがでたということは、実行時には
別のシートがアクティブになっているということになります。

それとも、データシート(Sheet3) がアクティブな状態(前面にでている状態)で
このメッセージがでたあということでしょうか?

もしかして・・・・
ゆーあさんの操作手順として、
・データシート(Sheet3)のコピーすべき行のセルを選ぶ
・それから、別のシートを選んで、なにかする
・で、この状態で(別のシートが表示されている状態で)マクロ実行
・マクロは、前に、データシート上で選択してあったセルの行のデータをコピーする。

もし、こういった流れがいいのなら、SampleA,B,Cともに

  'Just In Case
  If Not ActiveSheet Is dSh Then
    MsgBox dSh.Name & "をアクティブにしてから実行してください"
    Exit Sub
  End If

これを消して

Application.ScreenUpdating = False の下に

dSh.Select

を追加。

これでいけますけど・・・・

でも、自分だったら、ちゃんと、選んだ行を目で確認しながら実行しますけど。
さっき、ちゃんと正しい行を選んでいたかどうか、不安じゃないですか?

【76543】Re:コードを短くしたい
お礼  ゆーあ  - 14/12/30(火) 9:00 -

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

おはようございます。
コメントありがとうございます。

「Sheet3をアクティブにして下さい」となる、理由が分かりました!
元ブックの方が、
 Sheet1:フォーム呼出ボタンのみ(sheet表示)
 Sheet2:個人データ登録用シート(非表示)
 Sheet3:(各個人データ)データシート1(非表示)
 Sheet4:(各個人データ)データシート2(非表示)
としており、
フォーム帖の全ての操作の後、
唯一表示しているSheet1をアクティブになるようにしていた為、
Sheet3をアクティブにして下さいと出ておりました。。。

正しい行を選んだか確かに心配です。
少し操作を考えてみます。。。


しかし、お陰様で、
最初より大幅にコードが短くなり、
処理時間も短縮となりました。
望み通りの方向に導いて下さり、本当にありがとうございました。

お教え頂いたことを、もう一度良く読み返し実践し、
自分の力に変えれる様に頑張ります!
ありがとうございました!!

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