Excel VBA質問箱 IV

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

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

  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
4694 / 13646 ﾂﾘｰ ←次へ　｜　前へ→
▼ 【55094】元に戻すには ウィル 08/4/15(火) 11:02 質問[未読]
【55095】Re:元に戻すには ひげくま 08/4/15(火) 11:23 発言[未読]
【55101】Re:元に戻すには ウィル 08/4/15(火) 12:31 回答[未読]
【55102】Re:元に戻すには ひげくま 08/4/15(火) 12:54 回答[未読]
【55106】Re:元に戻すには stais 08/4/15(火) 15:09 回答[未読]
【55120】Re:元に戻すには ウィル 08/4/15(火) 23:44 回答[未読]
【55125】Re:元に戻すには stais 08/4/16(水) 12:51 発言[未読]
【55134】Re:元に戻すには ウィル 08/4/16(水) 15:26 回答[未読]
【55135】Re:元に戻すには stais 08/4/16(水) 16:15 回答[未読]
【55139】Re:元に戻すには ウィル 08/4/16(水) 16:45 回答[未読]
【55141】Re:元に戻すには stais 08/4/16(水) 17:03 回答[未読]
【55146】Re:元に戻すには stais 08/4/16(水) 17:31 回答[未読]
【55143】Re:元に戻すには stais 08/4/16(水) 17:08 質問[未読]
【55149】Re:元に戻すには ウィル 08/4/16(水) 20:11 お礼[未読]
【55094】元に戻すには
質問  ウィル  - 08/4/15(火) 11:02 -
引用なし
パスワード
   お世話になります。
報告書を別シート（リスト）に以下のようにして反映させています。

報告書に名前（AL2）と日付（L3）を入れ、リストから一致させて、
元の報告書に戻すには、どの様にしたらよろしいのでしょうか？

Sub Macro1()
　With Sheets("リスト").Range("B65536").End(xlUp)
　　.Offset(1, 0).Value = Sheets("報告書").Range("AL2").Value　'名前
　　.Offset(1, 1).Value = Sheets("報告書").Range("l3").Value　'日付
　　.Offset(1, 2).Value = Sheets("報告書").Range("l4").Value
　　.Offset(1, 3).Value = Sheets("報告書").Range("l5").Value
　　.Offset(1, 4).Value = Sheets("報告書").Range("l6").Value
　　.Offset(1, 5).Value = Sheets("報告書").Range("l8").Value
　　.Offset(1, 6).Value = Sheets("報告書").Range("l10").Value　　
　End With
End Sub

宜しくお願いいたします。
【55095】Re:元に戻すには
発言  ひげくま  - 08/4/15(火) 11:23 -
引用なし
パスワード
   こんにちは。

>報告書に名前（AL2）と日付（L3）を入れ、リストから一致させて、
>元の報告書に戻すには、どの様にしたらよろしいのでしょうか？

「リストから一致させて、元の報告書に戻す」の意味が解らないので、
もっと解りやすい説明をお願いします。
【55101】Re:元に戻すには
回答  ウィル  - 08/4/15(火) 12:31 -
引用なし
パスワード
   ひげくま さん　申し訳ありませんでした。
報告書の書式に記入したことを、リストに反映させています。

報告書
氏名　　加藤（AL2）
月日　　4/15（L3)
曜日　　火曜（L4）
機関　　ああ（L5）
区分　　いい（L6）　　　　　　　　　　　　　　　　　　　　　　　　
担当　　うう（L8）　　　　　　　　　　　　　　　　　　　　
報告　　ええ（L10）

リストに以下のように反映してあります。
氏名　月日　曜日　機関　　区分　　担当　　報告
加藤　4/15　火曜　ああ　　いい　　うう　　ええ　　　　
佐藤　4/15　火曜　　　　ああ　　いい　　うう　　ええ


報告書に名前と月日を記入した際、リストの情報から検索して
元の書式に反映することができますか？

報告書（検索情報）　　　報告書（検索結果後）
氏名　　佐藤　　　　　　　氏名　　佐藤
月日　　4/15　　　　　　　月日　　4/15　　　　
曜日　　　　　　　　　　　曜日　　火曜
機関　　　　　　　　　　　機関　　ああ
区分　　　　　　　　　　　区分　　いい　　　　　　　　　　　　
担当　　　　　　　　　　　　担当　　うう　　　　　　　　　　　　
報告　　　　　　　　　　　 　報告　　ええ　　
　　　　　　
うまく説明できませんが、大丈夫でしょうか？
宜しくお願い致します。
【55102】Re:元に戻すには
回答  ひげくま  - 08/4/15(火) 12:54 -
引用なし
パスワード
   何となくやりたいことは解ったような気もしますが・・・

「報告書」シートのデータを「リスト」シートに反映してるんですよね？
その逆をやれば良いだけではないのでしょうか？

というか、最初の「報告書」のデータをそのまま使えば良いだけだと思うのですが・・・

何をしたくて何に困っていてどういうマクロを組みたいのかがちょっとよく解りません。
私ではお力になれないかもしれません。
【55106】Re:元に戻すには
回答  stais  - 08/4/15(火) 15:09 -
引用なし
パスワード
   こんにちわ。
こう言う事かな？

Sub Test()
Dim Fi As Range, Ad As String, Ch As Boolean
Ch = True
With Worksheets("報告書")
　　 Set Fi = Worksheets("リスト").Columns(2).Find(.Range("AL2"), , xlValue, xlWhole)
　　 If Fi Is Nothing Then
　　　　Ad = Fi.Address
　　　　Do
　　　　　Set Fi = Worksheets("リスト").Columns(2).FindNext(Fi)
　　　　　If Fi.Offset(, 1).Text = .Range("l3").Text Then
　　　　　　 .Range("I4").Resize(3).Value = Application.Transpose(Fi.Offset(, 2).Resize(, 3).Value)
　　　　　　 .Range("I8").Value = Fi.Offset(, 5).Value
　　　　　　 .Range("I10").Value = Fi.Offset(, 6).Value
　　　　　　 Ch = False: Exit Do
　　　　　End If
　　　　Loop Until Ad = Fi.Address
　　 Else
　　　　GoTo End_Len
　　 End If
End With
If Ch Then GoTo End_Len
Exit Sub

End_Len:
　　 MsgBox "該当なし", vbInformation
End Sub
【55120】Re:元に戻すには
回答  ウィル  - 08/4/15(火) 23:44 -
引用なし
パスワード
   stais さん　ひげくまさん
お返事が遅くなりまして、申し訳ありません。

実際におこなってみましたが、
実行時エラー９
インデックスが有効範囲にありません。と出てしまいます。
どの様にしたらよろしいのでしょうか？

宜しくお願い致します。
【55125】Re:元に戻すには
発言  stais  - 08/4/16(水) 12:51 -
引用なし
パスワード
   ▼ウィル さん：
>stais さん　ひげくまさん
>お返事が遅くなりまして、申し訳ありません。
>
>実際におこなってみましたが、
>実行時エラー９
>インデックスが有効範囲にありません。と出てしまいます。
>どの様にしたらよろしいのでしょうか？
>
>宜しくお願い致します。

どこで出ますか？
シート名は有ってますか？（全角半角スペース等）
【55134】Re:元に戻すには
回答  ウィル  - 08/4/16(水) 15:26 -
引用なし
パスワード
   stais さん

ありがとうございます。
シート名が違っていました。

リストに記入してあり、実行してみましたが、
"該当なし"になってしまいます。

もし、解説していただければ、参考にして勉強したいと思います。
宜しくお願い致します。
【55135】Re:元に戻すには
回答  stais  - 08/4/16(水) 16:15 -
引用なし
パスワード
   こんにちわ。
コード説明です。
Sub Test()
Dim Fi As Range, Ad As String, Ch As Boolean
Ch = True
With Worksheets("報告書")
　　 'シート報告書のセルＡＬ２の氏名をリストシートの２列目の氏名を検索する
　　 Set Fi = Worksheets("リスト").Columns(2).Find(.Range("AL2"), , xlValue, xlWhole)
　　 '氏名が一致したのがあったかを区分
　　 If Fi Is Nothing Then
　　　 '有った場合
　　　　Ad = Fi.Address
　　　　'一致する指名が複数有った場合を想定してループにて確認
　　　　Do
　　　　　Set Fi = Worksheets("リスト").Columns(2).FindNext(Fi)
　　　　　'リストシートの一致した指名の隣のセル（Ｃ列）の日付と
　　　　　'シート報告書のセルＩ３の日付が一致しているかを確認
　　　　　If Fi.Offset(, 1).Text = .Range("l3").Text Then
　　　　　　　'データを転記
　　　　　　 .Range("I4").Resize(3).Value = Application.Transpose(Fi.Offset(, 2).Resize(, 3).Value)
　　　　　　 .Range("I8").Value = Fi.Offset(, 5).Value
　　　　　　 .Range("I10").Value = Fi.Offset(, 6).Value
　　　　　　 '変数ChをFalseにしループを抜ける
　　　　　　 Ch = False: Exit Do
　　　　　End If
　　　　Loop Until Ad = Fi.Address
　　 Else
　　　 '無かった場合End_Lenへ
　　　　GoTo End_Len
　　 End If
End With
'変数Chの値がTrueならEnd_Lenへ
'（ここで変数ChがTrue場合は日付が一致したのが無かったことになる）
If Ch Then GoTo End_Len
Exit Sub

End_Len:
　　 MsgBox "該当なし", vbInformation
End Sub

確認です。
シート報告書のセルの確認です
氏名＝AL2　ですか？
日付＝I3　ですか？

シートリストセルの確認です。
氏名＝B列　ですか？
日付＝C列　ですか？
【55139】Re:元に戻すには
回答  ウィル  - 08/4/16(水) 16:45 -
引用なし
パスワード
   stais さん
ありがとうございます。

>シート報告書のセルの確認です
>氏名＝AL2　はＡＬ２です。
>日付＝I3　 はＬ３です。
>シートリストセルの確認です。
>氏名＝B列　はＢ列です。
>日付＝C列　はＣ列です。
【55141】Re:元に戻すには
回答  stais  - 08/4/16(水) 17:03 -
引用なし
パスワード
   ▼ウィル さん：
>stais さん
>ありがとうございます。
>
>>シート報告書のセルの確認です
>>氏名＝AL2　はＡＬ２です。
日付＝I3　 はＬ３です。
>>シートリストセルの確認です。
>>氏名＝B列　はＢ列です。
>>日付＝C列　はＣ列です。

>If Fi.Offset(, 1).Text = .Range("l3").Text Then
If Fi.Offset(, 1).Text = .Range("L3").Text Then

としてください。
【55143】Re:元に戻すには
質問  stais  - 08/4/16(水) 17:08 -
引用なし
パスワード
   ▼ウィル さん：
追加確認です
転記先も「I列」出なく「L列」ですか？
なだとしたら転記のコードの部分を「I」を「L」に変更してください。
【55146】Re:元に戻すには
回答  stais  - 08/4/16(水) 17:31 -
引用なし
パスワード
   こんにちわ。
とんでもない間違いが
>If Fi Is Nothing Then
If Not Fi Is Nothing Then
でした。
【55149】Re:元に戻すには
お礼  ウィル  - 08/4/16(水) 20:11 -
引用なし
パスワード
   stais さん

ありがとうございます。
転記先は「Ｌ列」です。

できました。ながながとありがとうございました。
  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
4694 / 13646 ﾂﾘｰ ←次へ　｜　前へ→
ページ：  ┃  記事番号：
2610219
(SS)C-BOARD v3.8 is Free