エクセル、マクロを教えてください。 その日に宿泊予約が何件入っているかわかる表を作りたいです。

画像

Visual Basic | Excel160閲覧xmlns="http://www.w3.org/2000/svg">100

ベストアンサー

0

ありがとうございます。仰る通りです。 夏のボーナスが出たらエクセルを自宅でも使えるようにしようと思います! 金曜日に職場で試させていただき、うまく動きました! しかし、私が今までボタンを押すとマクロが実行されるというやり方しか経験なかったため、シート選択で実行する方法がわからず… 帰宅してから調べて、標準モジュールに入力した他に、プロジェクトエクスプローラーからシートを開き、オブジェクトのリストボックスで「Worksheet」を選択し、プロシージャのリストボックスで「Activate」を選択、そして記載いただいたコードを入力する、と言うのが必要なのかなと思いました。 明日試してみる予定です。

ThanksImg質問者からのお礼コメント

上手く出来ました!ありがとうございます。 私の返信の、標準モジュールへの入力という部分は不要でした。 もし、同じようなことで困ってこちらに行き着いた方がいた時のために(^^)

お礼日時:5/16 21:24

その他の回答(1件)

0

Option Explicit Dim dic As Object Dim ws1 As Worksheet Dim ws2 As Worksheet Sub Example() Set dic = CreateObject("Scripting.Dictionary") Set ws1 = Worksheets("Sheet1") Set ws2 = Worksheets("Sheet2") Call setList Call fillInSchedule Set dic = Nothing End Sub Sub setList() Dim r As Range For Each r In ws2.Range("A2", ws2.Cells(Rows.Count, "A").End(xlUp)) Dim checkin&: checkin = r.offset(, 1) Dim checkout&: checkout = r.offset(, 2) Dim d As Long For d = checkin To checkout If dic.Exists(d) Then dic(d).Add r Else Dim coll As Collection Set coll = New Collection coll.Add r dic.Add d, coll Set coll = Nothing End If Next Next End Sub Sub fillInSchedule() Application.ScreenUpdating = False Dim r As Range For Each r In ws1.Range("B1", ws1.Cells(1, Columns.Count).End(xlToLeft)) If dic.Exists(r.Value) Then Dim c, offset&: offset = 2 For Each c In dic(r.Value) c.Copy r.offset(offset) offset = offset + 1 Next End If Next Application.ScreenUpdating = True End Sub

画像

<シート名を変更する場合はここ> Set ws1 = Worksheets("Sheet1") Set ws2 = Worksheets("Sheet2") <一覧で顧客名が入っている列を "A列" から変更する場合はここ> For Each r In ws2.Range("A2", ws2.Cells(Rows.Count, "A").End(xlUp)) <カレンダーで日付が入っている行を "1"行目から変更する場合はここ> For Each r In ws1.Range("B1", ws1.Cells(1, Columns.Count).End(xlToLeft))