Excel VBA質問箱 IV

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

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


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

【5785】セル位置を取得してデータをコピーしたい 山内 03/5/30(金) 15:39 質問
【5795】Re:セル位置を取得してデータをコピーしたい Kein 03/5/30(金) 23:51 回答
【5799】Re:セル位置を取得してデータをコピーしたい 山内 03/5/31(土) 13:27 発言
【5801】Re:セル位置を取得してデータをコピーしたい 山内 03/5/31(土) 17:09 お礼

【5785】セル位置を取得してデータをコピーしたい
質問  山内 E-MAIL  - 03/5/30(金) 15:39 -

引用なし
パスワード
   毎月集めている会費の記録をとるマクロを作っています。

1)sheet1:会員名、金額をそれぞれコンボボックスから選ぶとE2:G2に自動的に「指名」「日付」「金額」が記入されます。
2)するとsheet1.D10:G22 の範囲の領収書レイアウト内に同じデータがコピーされます。
3)ボタンを押すと、領収書が印刷されます。

ここまでは何とかスムーズにおこなえます。しかし…

4)印刷と同時に、sheet2 の氏名一覧から同じ名前を検索し、その一番右側のセル位置を取得し、そこへ「日付」「金額」をコピーする。
という、記録シートへの記入をおこなわせたいのですが、方法がわかりません。
シートのデザインは以下の通りです。

 | A | B | C | D | E | F | G  |
-----------------------------------------------------
1| 氏名| 日付| 金額| 日付| 金額| 日付| 金額|
-----------------------------------------------------
2|赤井 |5/14 |3000 |6/20 |4000 |   |   |
-----------------------------------------------------
3|飯島 |4/30 |2000 |5/15 |5000 |   |   |
-----------------------------------------------------
4|植木 |   |   |   |   |   |   |
-----------------------------------------------------
5|大島 |5/10 |4000 |   |   |   |   |
-----------------------------------------------------
6|加藤 |   |   |   |   |   |   |
-----------------------------------------------------
7|佐藤 |4/30 |2000 |5/15 |5000 |   |   |
-----------------------------------------------------
8|田中 |5/10 |4000 |   |   |   |   |

記入シートは、上記のように「人」によって「右端の位置」が異なります。
そこで、A列の氏名の検索をしただけでは不完全なのです。
sheet1 から取り出した「日付」と「金額」を「氏名」レコードに加えていく形のものを作りたいわけです。
どなたか、お知恵を拝借できないでしょうか?
よろしくお願いします。

山内

【5795】Re:セル位置を取得してデータをコピーした...
回答  Kein  - 03/5/30(金) 23:51 -

引用なし
パスワード
   >E2:G2に自動的に「指名」「日付」「金額」が記入されます。
この仕組みがどうなっているか分からないので、そのまま E2:G2 の値を使って・・

Dim Nm As String
Dim xR As Variant

Nm = Sheets("Sheet1").Range("E2").Value
xR = Application.Match(Nm, Sheets("Sheet2").Columns(1), 0)
If Not IsError(xR) Then
  Sheets("Sheet1").Range("F2:G2").Copy Sheets("Sheet2") _
  .Cells(x, 256).End(xlToLeft).Offset(, 1)
Else
  MsgBox "名前が見つかりません", 48
End If

としたら、どうでしょーか ?

【5799】Re:セル位置を取得してデータをコピーした...
発言  山内 E-MAIL  - 03/5/31(土) 13:27 -

引用なし
パスワード
   kein様

早速のご回答をありがとうございます。
概ね良いように思うのですが
  Sheets("Sheet1").Range("F2:G2").Copy Sheets("入金シート").Cells(x, 256).End(xlToLeft).Offset(, 1)
ここでストップしてしまいます。
なお、"sheet 2" は "入金シート"と名前を変えてありましたので書き換えました。
1度目は「名前が見あたりません」が出ました。
これはうまく動作した証拠だと思います。
1度目のミスは、sheet1 に名前一覧と sheet2(入金シート)の名前一覧が微妙に異なっていたことが原因でした。(例:青木勇→青木 勇)
とすると、keinさんのスクリプトをコピーする仕方が違っていたのではないかと思います。
もう少し見直してみます。
動きましたら、再度もう少し詳しくご報告します。
ありがとうございました。
山内

【5801】Re:セル位置を取得してデータをコピーした...
お礼  山内 E-MAIL  - 03/5/31(土) 17:09 -

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

ありがとうございました。
お陰様で完成いたしました。

>Dim Nm As String
>Dim xR As Variant
>
>Nm = Sheets("Sheet1").Range("E2").Value
>xR = Application.Match(Nm, Sheets("Sheet2").Columns(1), 0)
>If Not IsError(xR) Then
>  Sheets("Sheet1").Range("F2:G2").Copy Sheets("Sheet2") _
>  .Cells(x, 256).End(xlToLeft).Offset(, 1)
     ↑
    ここをxRに書き換えれば良かったのですね。
最初は、本を見て意味も考えずに数値や名称を書き換えてばかりいましたが、じっくりと見直すことで、勉強になりました。
そして、「ああ、なるほどなぁ〜、うまくできてるんだなぁ〜」と感心いたしました。Cells の指定する行に、match関数で取得した変数を代入しなさいという意味なんですね。Endは知らなかったので、ヘルプで見てみました。
ありがとうございます。
一応、実名を変えて、
http://homepage3.nifty.com/mebius21/macro.html
<A href="file:///C:/Documents and Settings/yyama/My
"入金記録シートサンプル"に、完成したものをアップロードしました。
もし、よろしかったら見てやってください。
1週間くらい保管しておこうと思います。

山内

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