Excel VBA質問箱 IV

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

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


9513 / 13646 ツリー ←次へ | 前へ→

【26869】ブックの異なる元データを月単位のアクティブセルに貼り付ける方法 nossori 05/7/21(木) 21:12 質問[未読]
【26873】Re:ブックの異なる元データを月単位のア... kobasan 05/7/22(金) 0:56 回答[未読]
【26875】Re:ブックの異なる元データを月単位のア... nossori 05/7/22(金) 7:57 質問[未読]
【26877】Re:ブックの異なる元データを月単位のア... りん 05/7/22(金) 8:35 発言[未読]
【26890】Re:ブックの異なる元データを月単位のア... kobasan 05/7/22(金) 15:58 回答[未読]
【26901】Re:ブックの異なる元データを月単位のア... nossori 05/7/22(金) 22:17 質問[未読]
【26905】Re:ブックの異なる元データを月単位のア... kobasan 05/7/23(土) 0:55 回答[未読]
【26932】Re:ブックの異なる元データを月単位のア... nossori 05/7/23(土) 22:38 お礼[未読]
【26899】Re:ブックの異なる元データを月単位のア... kobasan 05/7/22(金) 22:10 発言[未読]

【26869】ブックの異なる元データを月単位のアクテ...
質問  nossori  - 05/7/21(木) 21:12 -

引用なし
パスワード
   下のような表があります。
この表の7月のRange("A4")をアクティブセルにして、関連のブックからデータを取り出して、貼り付けるマクロにしたく思っています。このA4のセルを指定したいのですが、どのようにしたら良いのでしょうか。また、その次には8月のRange("E4")をアクティブにしてデータを貼り付けることにも使えて、毎月のデータが順次アクティブセルを指定して貼り付けられるようにしたいんですが。

元データは「売上一覧」の A3にあり、月が変わる時にそのデータが消され、翌月のデータスペースになるので、月末に消す前にこのような一覧表に貼り付けをして、データをT機単位に管理したく考えています。
アクティブセルを活用しているのですが、7月の元データも8月の元データも、何時も このシートの「 A3 」に貼り付けられますが何処が問題なのでしょうか?教えていただきたくお願いします。


  A    B     C   D    E     F     G  H   I
1 7月              8月              9月・・・
2
3 月日  氏名ID  金額      月日   氏名ID   金額   月日・・・
4                  8月1日  0011    100
5                  8月2日  0022    200
6                  8月4日  0044    500
:
:
↑ ↑                ↑ ↑
張り込む前の表            仕上がりの表

Dim tBK As Workbook
  
  On Error Resume Next
  Set tBK = Workbooks("BB売上集計と請求書発行.xls")
  If Err Then
    Set tBK = Workbooks.Open("U:\AA売上と請求\BB売上集計と請求書発行.xls")
  End If
  On Error GoTo 0
  If tBK Is Nothing Then Exit Sub
  tBK.Worksheets("売上一覧").Range("A3", Cells(Rows.Count, 1).End(xlUp)).Resize(, 3).Select
  Selection.Copy ThisWorkbook.Worksheets(1).Cells(ActiveCell.Row, ActiveCell.Column)  ’↑の行ですがA3に貼られてしまいますが
  tBK.Close False
  Set tBK = Nothing

また、貼り付ける時に月が間違った場合、7月の元データを、8月の欄に貼り付けた場合に、張り込み位置が間違っているという
MsgBoxでアラームを出したいのですが・・・何か良い方法は無いでしょうか。

【26873】Re:ブックの異なる元データを月単位のア...
回答  kobasan  - 05/7/22(金) 0:56 -

引用なし
パスワード
   ▼nossori さん 今晩は

>この表の7月のRange("A4")をアクティブセルにして、関連のブックからデータを取り出して、貼り付けるマクロにしたく思っています。このA4のセルを指定したいのですが、どのようにしたら良いのでしょうか。また、その次には8月のRange("E4")をアクティブにしてデータを貼り付けることにも使えて、毎月のデータが順次アクティブセルを指定して貼り付けられるようにしたいんですが。
>
>元データは「売上一覧」の A3にあり、月が変わる時にそのデータが消され、翌月のデータスペースになるので、月末に消す前にこのような一覧表に貼り付けをして、データをT機単位に管理したく考えています。
>アクティブセルを活用しているのですが、7月の元データも8月の元データも、何時も このシートの「 A3 」に貼り付けられますが何処が問題なのでしょうか?教えていただきたくお願いします。
>

>
>Dim tBK As Workbook
>  
>  On Error Resume Next
>  Set tBK = Workbooks("BB売上集計と請求書発行.xls")
>  If Err Then


>    Set tBK = Workbooks.Open("U:\AA売上と請求\BB売上集計と請求書発行.xls")
’↑の行で、アクティブなブックがtBKになっています。

>  End If
>  On Error GoTo 0
>  If tBK Is Nothing Then Exit Sub

=============ここから
>  tBK.Worksheets("売上一覧").Range("A3", Cells(Rows.Count, 1).End(xlUp)).Resize(, 3).Select
>  Selection.Copy ThisWorkbook.Worksheets(1).Cells(ActiveCell.Row,
                                ~~~~~~~~~~~~~~~
                                ’↑tbkのアクティブなセルです。
ActiveCell.Column
~~~~~~~~~~~~~~~~~~
’↑tbkのアクティブなセルです。
'===============================ここまで削除し、以下に置き換える

  Dim copy元 As Range


  Set copy元 = tBK.Worksheets("売上一覧").Range("A3", _
        Cells(Rows.Count, 1).End(xlUp)).Resize(, 3)
  
  With ThisWorkbook.Worksheets(1)
    If .Cells(3, 256).End(xlToLeft).Column < 3 Then
      copy元.Copy .Cells(3, 256).End(xlToLeft)
    Else
      copy元.Copy .Cells(3, 256).End(xlToLeft).Offset(0, 1)
    End If
  End With

'=====================ここまで
>  tBK.Close False
>  Set tBK = Nothing


>また、貼り付ける時に月が間違った場合、7月の元データを、8月の欄に貼り付けた場合に、張り込み位置が間違っているという
>MsgBoxでアラームを出したいのですが・・・何か良い方法は無いでしょうか。

これまで考える時間はありません。あしからず。

【26875】Re:ブックの異なる元データを月単位のア...
質問  nossori  - 05/7/22(金) 7:57 -

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

おはようございます。

よく分かりました。ありがとうございます。

offset(,1)で合っていると思いましたが。
何故か?offset(,2)にしないと定位置に入りませんでした。
一行空けですので・・・「1」の指定でよいと思うのですが。

この下のset以降は勉強になりました。

>  Dim copy元 As Range
>
>  Set copy元 = tBK.Worksheets("売上一覧").Range("A3", _
>        Cells(Rows.Count, 1).End(xlUp)).Resize(, 3)
>  
>  With ThisWorkbook.Worksheets(1)
>    If .Cells(3, 256).End(xlToLeft).Column < 3 Then
>      copy元.Copy .Cells(3, 256).End(xlToLeft)
>    Else
>      copy元.Copy .Cells(3, 256).End(xlToLeft).Offset(0, 1)
                              ’↑↑↑↑↑
>    End If
>  End With
>
>'=====================ここまで
>>  tBK.Close False
>>  Set tBK = Nothing
>
>
>>また、貼り付ける時に月が間違った場合、7月の元データを、8月の欄に貼り付けた場合に、張り込み位置が間違っているという
>>MsgBoxでアラームを出したいのですが・・・何か良い方法は無いでしょうか。
>
>これまで考える時間はありません。あしからず。

考えてまた、ご質問するかも知れませんので、そのときはよろしくお願いします。
失礼します。御礼まで。

【26877】Re:ブックの異なる元データを月単位のア...
発言  りん E-MAIL  - 05/7/22(金) 8:35 -

引用なし
パスワード
   おはようございます。

>offset(,1)で合っていると思いましたが。
>何故か?offset(,2)にしないと定位置に入りませんでした。
>一行空けですので・・・「1」の指定でよいと思うのですが。
offset(,1)は隣の列なので(A → B)、
1列空け(A → C ?) なので 2列隣 ということでは?

【26890】Re:ブックの異なる元データを月単位のア...
回答  kobasan  - 05/7/22(金) 15:58 -

引用なし
パスワード
   ▼nossori さん 今日は。


>offset(,1)で合っていると思いましたが。
>何故か?offset(,2)にしないと定位置に入りませんでした。
>一行空けですので・・・「1」の指定でよいと思うのですが。
>

月日(A列) 氏名ID(B列) 金額(C列) 月日(D列) 氏名ID(E列) 金額(F列)
と思って、コードを作ったのでoffset(0,1)にしました。

月日(A列) 氏名ID(B列) 金額(C列) (D列) 月日(E列) 氏名ID(F列) 金額(G列)
なら、offset(0,2)でいいと思います。

Cells(3, 256).End(xlToLeft)は、データのある最終セルです。
このことが分かれば納得できると思います。

【26899】Re:ブックの異なる元データを月単位のア...
発言  kobasan  - 05/7/22(金) 22:10 -

引用なし
パスワード
   ▼nossori さん 今晩は。

>  Set copy元 = tBK.Worksheets("売上一覧").Range("A3", _
>        Cells(Rows.Count, 1).End(xlUp)).Resize(, 3)


この部分は、コード書き方によってはエラーを誘発するので、以下のように訂正してください。

with tBK.Worksheets("売上一覧")
  Set copy元 = .Range("A3", .Cells(Rows.Count, 1).End(xlUp)).Resize(, 3)
'          ~~~        ~~~
End With

【26901】Re:ブックの異なる元データを月単位のア...
質問  nossori  - 05/7/22(金) 22:17 -

引用なし
パスワード
   ▼kobasan さん:
そして りんさん こんばんは。

アドバイスありがとうございました。勘違いしていました。
その通りです。失礼しました。
>
>>offset(,1)で合っていると思いましたが。
>>何故か?offset(,2)にしないと定位置に入りませんでした。
>>一行空けですので・・・「1」の指定でよいと思うのですが。
>>
>
>月日(A列) 氏名ID(B列) 金額(C列) 月日(D列) 氏名ID(E列) 金額(F列)
>と思って、コードを作ったのでoffset(0,1)にしました。
>
>月日(A列) 氏名ID(B列) 金額(C列) (D列) 月日(E列) 氏名ID(F列) 金額(G列)
>なら、offset(0,2)でいいと思います。
>
>Cells(3, 256).End(xlToLeft)は、データのある最終セルです。
>このことが分かれば納得できると思います。

はい、分かりました。
色々とアドバイスありがとうございます。

また、kobasanさん
アドバイスいただけませんでしょうか。考えて、後の続きをやりましたが、また砂山にはまり込みそうです。一寸コードを書きましたのでみてください。

頂いたコードで無事完了しました。そこで、
Setを何とか1ケ所だけで、「シートに名前をつけ」てコードを作りました。
後は、kobasanからのご指摘のコードを利用させていただき、上手く行きました。

残るのは、毎日の売上を棒打ちにしているので、7月度の集計に、万が一8月分の売りが混在した時の「Msg」によるアラームと元データが貼り付けられないようにしたいのですが・・・
上手く行きません。

7月度のシリアルナンバーを裏に持たせ、7月度は7月31日のシリアルナンバーにしています。8月1日はシリアルナンバーが「 1 」大きいのでそれで、不等号記号を用いて
Msgのメッセージを出そうとしたのですが・・・

A3に7月(実際は7月31日のシリアルナンバーです)
データの貼り付けは6行目からです。(最初のものは4行目でしたが6行目からに変更しました。)


Dim tBK As Workbook
  
  On Error Resume Next
  Set tBK = Workbooks("AAA売上集計と請求書発行.xls")
  If Err Then
    Set tBK = Workbooks.Open("U:\AAA売上と請求\AAA売上集計と請求書発行.xls")
  End If
  On Error GoTo 0
  If tBK Is Nothing Then Exit Sub
  tBK.Worksheets("売上一覧").Range("A3", Cells(Rows.Count, 1).End(xlUp)).Resize(, 3).Select
  
    With Workbooks("データベース作成").Worksheets("月次集計")
    If .Cells(6, 256).End(xlToLeft).Column < 3 Then
      Selection.Copy .Cells(6, 256).End(xlToLeft)
    Else
      Selection.Copy .Cells(6, 256).End(xlToLeft).Offset(0, 2)
    End If
    End With
  
  tBK.Close False
  Set tBK = Nothing
   Cells(6, 256).End(xlToLeft).Offset(, -2).Select

’ここまではご指導いただき上手く行きました。  
' 問題はここからです⇒シリアルナンバーが出てきませんが、どのようにすると良い ’のでしょうか?
  
   M = ActiveCell.Offset(-3)
   M.NumberFormatLocal = "G/標準"
   MyR = Range(Selection, Selection.End(xlDown))

  For Each R In MyR
  R.NumberFormatLocal = "G/標準"
  If R.Value > M.Value Then
  MsgBox "該当月のデータ以外があります" & Chr(10) & "見直しをしてください"
  End If
  Exit Sub

  Next

更に、アラーム(Msgboxで表示後、OKをおせば)後は、そのままExitさせたいのですが。コードの書く位置が今一分かりません。

お時間が許せましたら、アドバイスお願いします。

【26905】Re:ブックの異なる元データを月単位のア...
回答  kobasan  - 05/7/23(土) 0:55 -

引用なし
パスワード
   ▼nossori さん 今晩は。

>A3に7月(実際は7月31日のシリアルナンバーです)
データの貼り付けは6行目からです。(最初のものは4行目でしたが6行目からに変更しました。)


>' 問題はここからです⇒シリアルナンバーが出てきませんが、どのようにすると良い ’のでしょうか?


Dim R As Range
Dim M As Range
Dim MyR As Range
  Set M = Range("A3")
  M.NumberFormatLocal = "G/標準"
  '
  Set MyR = Range("A6", Range("A65536").End(xlUp))
  MyR.NumberFormatLocal = "G/標準"
  For Each R In MyR
    If R.Value > M.Value Then
      MsgBox "該当月のデータ以外があります" & Chr(10) & "見直しをしてください"
      Exit Sub
    End If
  Next
でできると思います。


>   M = ActiveCell.Offset(-3)
>   M.NumberFormatLocal = "G/標準"
>   MyR = Range(Selection, Selection.End(xlDown))
>
>  For Each R In MyR
>  R.NumberFormatLocal = "G/標準"
>  If R.Value > M.Value Then
>  MsgBox "該当月のデータ以外があります" & Chr(10) & "見直しをしてください"
>  End If
>  Exit Sub
>
>  Next


それからコードを見て思ったことは、極力 ActiveCellやSelection
は使わない方がいいと思います。

Workbooks("AAA売上集計と請求書発行.xls")
Worksheets("売上一覧")
Workbooks("データベース作成")

の3つのワークブックと複数のシートを扱う場合、どのブックのどのシートかを明確にすると、分かりやすくなり、トラブルが少なくなります。

【26932】Re:ブックの異なる元データを月単位のア...
お礼  nossori  - 05/7/23(土) 22:38 -

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

今晩は。
ご指摘ご指導ありがとうございました。
勉強になりました。
今後ともよろしくお願いいたします。

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