Excel (VBA)

Excel VBAに関するフォーラムです。
  • 解決済みのトピックにはコメントできません。
このトピックは解決済みです。
質問

 
(指定なし : 指定なし)
ワークシート間の移行がうまくゆきません
投稿日時: 19/11/04 00:51:44
投稿者: FANTA66

皆さま。いつも拝見しております。掲題の事で実行したい事がうまくゆきません。
是非、間違えを教えていただけますようお願い申し上げます。
 
質問:ワークシート内の複数のレコードに繰り返し同じデータを書き込みし、
   最終行まで到達後、ワークシート間の移行ができません。
 
ブックの概要:
   作成中のブックには11のワークシートがあります。そのうち、
   ・5つ目はワークシート名「ファイル名一覧」(=マスター)
   ・6つ目以降はワークシート名「001」から「006」です。(=データ)
    (データはCSV読込をしています・・・可変で最大「020」くらいまで)
   ・1つ目から4つ目のワークシートは「001」からの複数データをまとめ、
    いくつかの方法の抽出用テーブルとして使用しています。
   
   ・ワークシート「ファイル名一覧」の中身は、
     001(CSVファイル名)、日付、摘要の三項目のデータが、
     6行分あります。(1行目は見出し)
   ・ワークシート「001」から「006」は、
     氏名が100件前後のレコードがあります。
   
   ⇒ワークシート「001」から「006」の氏名のあとに
    マスターシートの日付、摘要を割り当てしてゆきたいと考えています。
    
 
☆私が書いたプログラムです。
 以下にコメントアウトさせた状態を載せました。
 この場合はワークシート間の移行はできます。が、コメントを
 戻すとひとつのワークシート内で繰り返す動作になってしまいます。
 コードの記述の順番を入れ替えたりしてみましたが、どうにもうまくゆきません。
 
 
Sub ファイルに情報を追加する()
Dim i As Integer, j As Integer, k As Integer, LastRow1 As Integer, LastRow2 As Integer
LastRow1 = Worksheets("ファイル名一覧").Range("A1048576").End(xlUp).Row
 
For i = 6 To Worksheets.Count
LastRow2 = Worksheets(i).Range("A1048576").End(xlUp).Row
With Worksheets(i)
Worksheets(i).Activate
' For j = 2 To LastRow1
' For k = 2 To LastRow2
' .Cells(k, 3).Value = Worksheets("ファイル名一覧").Cells(j, 2).Value
' .Cells(k, 4).Value = Worksheets("ファイル名一覧").Cells(j, 3).Value
' Next k
' Next j
End With
Next i
End Sub
 
 
どうぞよろしくお願い申し上げます。

回答
投稿日時: 19/11/04 08:33:02
投稿者: WinArrow
投稿者のウェブサイトに移動

いくつか質問させてください。
 
(1)移行
という意味がよくわかりません。
もう少し、具体的な言葉でお願いします。
 
(2)シートの順番について
シートの順番は、手操作で順番を変更することができてしまいます。
ですから、6番目以降というような既定的な対応ではなく、
シート名で指定したほうが無難です。
 
(3)データの整合性
データシートに行番号で、日付と摘要を転記していますが、
氏名などで照合する必要はないのですか?
 
(4)インデントについて
コードはインデントをつけて記述しましょう。
見やすいことは、間違いを探すのにとてもやくにたちます。
 
(5)シートのActivateについて
 シートをActivateやSelectしなくてお処理可能です。
 レスポンスを抑える意味でもやめた方がよいです。
 
 

回答
投稿日時: 19/11/04 10:21:50
投稿者: WinArrow
投稿者のウェブサイトに移動

>うまくいきません
ループが2重ループになっています。
おそらく、このループに起因いていると思います。
データシートとマスタシートの行ごとの関連を説明してください。
 
例えば、
データシートの2行目の氏名は、マスターシートの同じ行の氏名に対応している。
 
もし、データシート側の氏名でマスターシートの氏名を検索して・・・・
という考え方ならば、現在の2重ループを変更することになります。

回答
投稿日時: 19/11/04 10:22:40
投稿者: simple

<<「ファイル名一覧」>>
    A列      B列         C列         
1   シート   日付        摘要
2   001      2019/11/03  支給済み
3   002      2019/11/04  支給済み
4   003      2019/11/05  支給済み
(以下略)

<<「001」シート>>
    A列      B列         C列         D列
1   No       氏名        日付        摘要
2   1        a
3   2        b
4   3        c  
5   (以下略)

やりたい作業は、
ファイル名一覧の2行目をとる
   001シートの必要箇所に、日付、摘要を転記
ファイル名一覧の3行目をとる
   002シートの必要箇所に、日付、摘要を転記
ファイル名一覧の4行目をとる
   003シートの必要箇所に、日付、摘要を転記
・・・・
と言う作業ですか?
そのことを For ループで表現するにはどうするか、という話ですね。
 
----------------
そうすると、本当に、以下の掛け算の回数が必要になりますか?
6シート×6行×100件×2項目
 
For i = 6 To Worksheets.Count
   For j = 2 To LastRow1 ' "ファイル名一覧"の行のループ
      For k = 2 To LastRow2 ' 各シートの行のループ
           .Cells(k, 3).Value = Worksheets("ファイル名一覧").Cells(j, 2).Value
           .Cells(k, 4).Value = Worksheets("ファイル名一覧").Cells(j, 3).Value
      Next
   Next
Next
(上記は擬似コードです。考え方を示すためのものです)
 
6シートと6行は掛け算の36回は必要なく、6回で済むのではないですか?
二重ループで書けそうですが、いかがですか?

投稿日時: 19/11/04 10:24:03
投稿者: FANTA66

WinArrow様。おはようございます。
ご連絡をありがとうございます。わかりにくい内容でごめんなさい。
また、わかりにくいかと思います・・・。
 
それとお詫び申します。
本日は墓参り(だいぶ遠方です)に出掛けたりする予定がありまして、
スマホでメールは拝見できますが、回答はパソコンがないためお答えができなくなります。
 
ご質問をいただきました点に回答いたします。
よろしくお願い申し上げます。
 
(1)移行を具体的に現しますと以下になります。
  ◆ワークシート「ファイル名一覧」の中身
   (項目)ファイル名、日付、摘要
      001、9999/99/99、〇〇の予約 
      002、9999/99/99、〇〇の予約
       ・
       ・
      006、9999/99/99、〇〇の予約
       このファイル名がデータは多い時で20種類くらいまで
       増えるときもあり、増減幅とみてください。
 
  ◆ワークシート「001」から「006」をCSV読込直後。
   各ワークシートに整理番号と、氏名だけの情報があります。
   (項目)整理番号、氏名、日付、摘要 
      999999、〇〇〇〇、9999/99/99、〇〇の予約
       ・
       ・ 件数のお客様情報は予約数として増減します。
      999999、〇〇〇〇、9999/99/99、〇〇の予約
 
  ◇マクロでやりたい事として
   ・ワークシート「001」から順に「ファイル名一覧」で用意した
    ファイル名に一致した日付と摘要を付け足ししたいと考えています。
   (項目)整理番号、氏名、日付、摘要 
      999999、〇〇〇〇、情報なし、情報なし
       ・
       ・ お客様情報は予約数として増減します。
      999999、〇〇〇〇、情報なし、情報なし
  
(2)シートの順番は、
  ・最終的にはフォーム表示にて起動するよう検討しています。
   従いまして、ワークシートへは直に触れる事ができなくなります。
   そのことからワークシート(1)から(5)の固定できると考えております。
  ・決めたフォルダ内にCSV形式の外部データが置くため、
   あらかじめ、パソコン内のフォルダにあるファイル名を取得する設計にしています。
   CSVファイル数が可変するので、ワークシート(6)以降に今回の事を
   施したいので敢えてシート名は付けておりません。
  ・また、ワークシート(6)以降はワークエリアとして考えていますので、
   このプログラムを起動する際にワークシート(6)以降は削除するように
   UserForm_Initializeにマクロを書いています。
   データインポート時はワークシート(6)は必ず「001」となりますが、
   可変数なファイルのため、面倒なのでシート名指定まではしていないのが
   実情です。
 
(3)データの整合性
   最終的には、ワークシート(1)に加工したデータを移します。
   そこで、整理番号の抽出と、氏名(上位一致)の抽出も可能になるよう設計します。
  
(4)インデントについて
すみませんでした。以下にあらためてコピーを置きます。
 
    以下の中でコメントアウトをしていると、Worksheets.Countが効き
    ワークシート(6)から後ろ側の(11)まで進める事ができるのですが、
    コメントアウトを外すと、途端にワークシート内で作業が繰り返されるようになってしまいます。
    
    また、大変恐縮でございますが、
    Worksheets(i).Activateは、ステップインで動作確認が可能となるように入れておりました。
    言い訳で申しましてすみません。
 
 
Sub ファイルに情報を追加する()
Dim i As Integer, j As Integer, k As Integer, LastRow1 As Integer, LastRow2 As Integer
 
LastRow1 = Worksheets("ファイル名一覧").Range("A1048576").End(xlUp).Row
  
For i = 6 To Worksheets.Count
LastRow2 = Worksheets(i).Range("A1048576").End(xlUp).Row
    With Worksheets(i)
    Worksheets(i).Activate
' For j = 2 To LastRow1
' For k = 2 To LastRow2
' .Cells(k, 3).Value = Worksheets("ファイル名一覧").Cells(j, 2).Value
' .Cells(k, 4).Value = Worksheets("ファイル名一覧").Cells(j, 3).Value
' Next k
' Next j
    End With
Next i
End Sub
 
 
 
 

投稿日時: 19/11/04 10:29:04
投稿者: FANTA66

ごめんなさい。
たくさんコメントを頂戴していたにも関わらず大変失礼をいたしました。
私がエディタで書いたメールを送信してから気が付きました。
 
ざっくり斜め読みしかできませんで、このメッセージを書いています。
どうしても自由な時間が無くなってしまいます。
遅くなりますが、帰宅後に再度確認させていただきたく思います。
 
申し訳ございません・・・。

回答
投稿日時: 19/11/04 10:48:12
投稿者: WinArrow
投稿者のウェブサイトに移動

まだ、しっかり、理解したわけではありませんが、
 
マスターシート側には、データシートのシート名が存在しますよね?
そうすると、
データシート側では、データが存在する件数(行数)分、同じ日付と摘要を転記する
ということになりませんか?
 
この仕様でよければ、
マスターシートの行数分ループし
ファイル名(シート名)和賀の全データに日付と摘要を転記する
というようになります。
 
With WorksheetS("ファイル名一覧")
    For Row2 = 2 to .Range("A" & .Rows.Cunt).End(xlUp).ROw
        データシート名 = .Cells(Row2, "A").Value
       Row1 = Worksheets(データシート名).Range("A" & Worksheets(データシート名).Rows.Count).End(xlUp).Row
      Worksheets(データシート名).Range("C2:D" & Row1).Value = .Cells(Row2, "B").Resize(2).Value
    Next
 
このようなコードが参考になりますか?
 
 
なお、掲示のコードは、全くインデントが付いていません。
 
 

回答
投稿日時: 19/11/04 13:52:49
投稿者: WinArrow
投稿者のウェブサイトに移動

マスターシートの中のファイル名について
「001」〜「020」と説明されていますが、
実際のCSVファイルのファイル名なのか?
それとも、データシートのシート名なのか?
 
後者だとすると、
そのデータを変数に格納すれば、
Sheets(変数名)
とすることで、シート名でアクセスすることができます。
インポートしてしまえば、CSVファイル名絵は意味がなくなります。

投稿日時: 19/11/04 14:52:08
投稿者: FANTA66

WinArrowさん
simpleさん
 
ありがとうございます。
急用が出来たので墓参りせずに自宅に戻りました。
しかしながら、準備ができ次第その急用のため夕方にまた外出します。
その準備を家族がしている合間の連絡となります。
 
 
まず、WinArrowさんありがとうございます。
説明が足りず大変失礼をしております。
WinArrowさんにいただいた内容ですと、
じっくり考えてみないと短い時間ではわかりませんでした。
 
simpleさんもありがとうございます。
ご解釈いただいた内容で間違えないように思います。
 
もう一度概略を書きます。実例のように少し書き足してみました。
(あまり変わらないとは思いますが・・・)
  ◆マスターのシートとして
   ワークシート「ファイル名一覧」の中身
   (項目)ファイル名(=ワークシート名)、日付、摘要
      001、2019/11/03、〇〇の予約 
      002、2019/11/04、△△の予約
       ・
      006、2019/12/04、××の予約
       このファイル名がデータは多い時で20種類くらいまで
       増えるときもあり、増減幅とみてください。
  
  ◆CSVデータとして
   各ワークシートに整理番号と、氏名だけの情報があります。
   ワークシート「001」から「006」の中身
   (項目)整理番号、氏名、日付、摘要 
      999999、〇〇〇〇、情報なし、情報なし
       ・
       ・ お客様情報は予約数として増減します。
      999999、〇〇〇〇、情報なし、情報なし
 
  ◇以下は結果です。
   読込済のCSVデータに共通した情報を入れたいと考えています。
   
   ◎ワークシート「001」
   (項目)整理番号、氏名、日付、摘要 
      999999、〇〇〇〇、2019/11/03、〇〇の予約
       ・
       ・ 件数のお客様情報は予約数として増減します。
      999999、〇〇〇〇、2019/11/03、〇〇の予約
      
       ↓ ワークシート「001」の人数分の書き込みを終えたら
       ↓ ワークシート「002」に移行し、同様の作業を行います。   
       
   ◎ワークシート「002」
   (項目)整理番号、氏名、日付、摘要 
      999999、〇〇〇〇、2019/11/04、△△の予約
       ・
       ・ 件数のお客様情報は予約数として増減します。
      999999、〇〇〇〇、2019/11/04、△△の予約
      
       ↓
       
   ◎ワークシート「006」まで継続して作業をします。
 
 
それと、おっしゃる通りCSV読込後はこだわる必要はないと思います。
実際のCSVファイルのファイル名=データシートのシート名としています。
変数に格納すれば、あらかじめ決めたワークシート名をCSV読込先と
する事ができるかと思います。
 
Sub ファイルに情報を追加する()
Dim i As Integer, j As Integer, k As Integer, LastRow1 As Integer, LastRow2 As Integer
LastRow1 = Worksheets("ファイル名一覧").Range("A1048576").End(xlUp).Row
  
  For i = 6 To Worksheets.Count ←コメントアウト中はここが動作してますが・・。
                  コメントアウトから戻すとFor j - Next jしか
                  繰り返さなくなります・・・。
      LastRow2 = Worksheets(i).Range("A1048576").End(xlUp).Row
      With Worksheets(i)
      Worksheets(i).Activate
' For j = 2 To LastRow1
' For k = 2 To LastRow2
' .Cells(k, 3).Value = Worksheets("ファイル名一覧").Cells(j, 2).Value
' .Cells(k, 4).Value = Worksheets("ファイル名一覧").Cells(j, 3).Value
' Next k
' Next j
      End With
  Next i
End Sub
 
いろいろとありがとうございます。

投稿日時: 19/11/04 14:55:14
投稿者: FANTA66

ごめんなさい。
今度こそインデントしたつもりですが、
データ送信後確認してみましたが、うまくゆきませんでした。
特にコメントアウト部分のスペースが死にました・・・。
 
どうぞよろしくお願いいたします。

回答
投稿日時: 19/11/04 17:05:07
投稿者: WinArrow
投稿者のウェブサイトに移動

個々のセルにデータを格納(転記)するより
セル範囲でデータを一挙に格納したほうが早いし、メモリ消費も少ないです。
加えてファイル容量増加も抑えることができます。
 
With Workshssts(データシート側の名前)
    .Range("C2:D" & 行数分).Value = Worksheets("マスタシート").Cells(行,"B").Resize(2).value
End With
 
とすると、一挙に100行分データが転記されます。
 

投稿日時: 19/11/04 21:34:09
投稿者: FANTA66

WinArrow さん。
ありがとうございます。
遅くなってすみません。早速、以下のように試してみました。
確かに一度にデータシート側のレコード件数分書かれます!!
また、ワークシート間の移行もします!!!!驚きました!!
 
しかし、書かれたデータが #N/A と表示されてしまいます。
これは、データがないとか・・。エラーの場合ですよね。
 
あらためまして、何がいけないのでしょうか?
また、以下のように書かれるときの初めの行が三行目スタートとなります。
 整理番号、氏名漢字、日付、摘要
 232695 〇〇〇〇〇            
 2315     〇〇〇〇〇            
 314064 〇〇〇〇〇 #N/A #N/A ・・・三行目    
 321563 〇〇〇〇〇 #N/A #N/A ・・・四行目    
 
以下にあらためて書いたマクロを載せます。
よろしくお願いいたします。
 
Sub ファイルに情報を追加する()
Dim i As Integer, LastRow1 As Integer, LastRow2 As Integer
LastRow1 = Worksheets("ファイル名一覧").Range("A1048576").End(xlUp).Row
    For i = 6 To Worksheets.Count
      LastRow2 = Worksheets(i).Range("A1048576").End(xlUp).Row
      With Worksheets(i)
          .Range("C2:D" & LastRow2).Value = Worksheets("ファイル名一覧").Cells(LastRow1, "B").Resize(2).Value ・・・ この部分が怪しいと見当はつくのですが。
      End With
    Next
End Sub

回答
投稿日時: 19/11/04 22:27:59
投稿者: WinArrow
投稿者のウェブサイトに移動

引用:
Sub ファイルに情報を追加する()
Dim i As Integer, LastRow1 As Integer, LastRow2 As Integer
 LastRow1 = Worksheets("ファイル名一覧").Range("A1048576").End(xlUp).Row
     For i = 6 To Worksheets.Count
       LastRow2 = Worksheets(i).Range("A1048576").End(xlUp).Row
       With Worksheets(i)
           .Range("C2:D" & LastRow2).Value = Worksheets("ファイル名一覧").Cells(LastRow1, "B").Resize(2).Value ・・・ この部分が怪しいと見当はつくのですが。
      End With
     Next
 End Sub

 
↑のコードの中で
取得したLastRow1は、「ファイル名一覧」シートの最終行ですよね?
 
各シートに最終行のデータを、転記していることになりますが、
データシートに対応した日付と摘要を複写するのではないでしょうか?
 
それは俺として、
>Worksheets("ファイル名一覧").Cells(LastRow1, "B").Resize(2).Value
は、Resizeの使い方がおかしいです。
Resize(2)は、
Cells(LastRow1, "B")を含めて2行・・・・
LastRow1が6の場合、B6:B7と指定したことになります。
B6:C6にするには
Worksheets("ファイル名一覧").Cells(LastRow1, "B").Resize(,2).Value
と記述します。但し、LastRow1は使えませんよ。
 
現在のデータシートをループする方法だと
データシートに対応するマスターシートの行を検索するのに、
また、ループが必要になります。2階建て(2重)ループ
 
マスターシート側をループさせて、ファイル名に対応するシートを取得したほうが
ループは
1階建てループで済みます。
さらに言えば、6番目以降と限定してしまうと、
将来、1〜5のシートが増えると、コードも変更しなくてはいけない。
6番目以降を削除するコードにも関係するが・・・
できれば、データシート名をCSVファイル名ではなく、特別な文字を先頭に配置して
削除するときは、その文字を含むシートを削除するとかにすれば、よいでしょう。
 
例えば、
「001」を「DATA001」という名前にする
 

投稿日時: 19/11/04 23:23:03
投稿者: FANTA66

WinArrow さん。ありがとうございました。
 
・LastRow1は確かに最終行を算出していますので、その変数ではなく、行指定で解消できました!!
 ご指摘を読み誤っていました。
・Worksheet(i)の変数iを利用して「マスターの該当する行数」を算出させて、マスターファイルの
 一行目のデータをワークシート001の行数分全てに書き込みさせる事ができました!!
 さらに、必要なワークシートにて同様の結果が得られました!!!
・Resizeもつかめました。
 
以下の書き方でうまく動作できました!!
 
Sub ファイルに情報を追加する2()
Dim i As Integer, LastRow1 As Integer, LastRow2 As Integer
 
    For i = 6 To Worksheets.Count
    LastRow2 = Worksheets(i).Range("A1048576").End(xlUp).Row
    With Worksheets(i)
        .Range("C2:D" & LastRow2).Value = Worksheets("ファイル名一覧").Cells(i - 4, "B").Resize(, 2).Value
    End With
    Next
End Sub
 
・ファイル名については前述通りにあるフォルダ内にあるCSVファイルの
 ファイル名を取得するときに、"DATA"を付加して"DATA001"で取得する事にいたしました。
 また、削除のときに"DATA〜"で始まるワークシートの指定で一括削除ができましたので、
 他のワークシートを誤って削除する事がなくせました!!
 より安全なマクロが記述できました。
 こちらも教えていただいてありがとうございました。
 
もっと、マクロについて個々の言葉の意味をより理解できるよう頑張ってまいります。
また、教えてください。
 
最後になり誠に恐縮でございますが、
simple さん!ありがとうございました!!!
おかげさまで今回の質問の成果が得られました。
 
 

投稿日時: 19/11/05 08:05:26
投稿者: FANTA66

ありがとうございました