Sheet1には以下のようにデータが入力されています。
A列(日付) B列(顧客コード) C列(顧客名) D列(商品名)
09/09/09 1004 上田 SSS
09/09/09 1004 上田 SSS
09/09/09 1005 山田 AAA
09/09/10 1004 上田 SSS
09/09/10 1005 山田 AAA
09/09/10 1006 田中 BBB
09/09/10 1004 上田 SSS
09/09/10 1005 山田 AAA
Sheet2以降は、顧客コード別に分かれたシート(シート名=顧客コード)が並んでおり、それぞれ顧客の情報が入力されています。
A列で印刷範囲を指定し(毎日印刷するため、9月10日であれば9月10日の日付分だけ)、B列のコードと同じコード名のシートを印刷するという手順になります。実際は、もっとデータがたくさんありますので手作業ではとても困難になってしまいます。
マクロでやってみようと思い、作成してみたのですが、下記に添付しているマクロでは、Sheet1で同日に同じコードがある場合、シートが重複して印刷されてしまいます。
上記の例で言いますと、9月10日の日付5行を範囲として、B列のコードと同じコード名のシートを検索して印刷するのですが、1004が2つ、1005が2つと、シートが重複してしまいます。
なんとかして、重複するコードは印刷しないという技はないものでしょうか。重複データを消去するという手段は、残念ながら、全て必要なデータですのでそれはできないのです。
マクロ初心者で、応用がなかなか利かないため、どうしても皆さんのお力をお借りしたく、ここへ質問させていただきました。
これからの勉強を兼ねて、ご回答くださる方々の意見を十分に参考にさせていただきたいと思っておもりますので、どうぞよろしくお願いいたします。
Sub test1()
Dim n As Long
Dim R1 As Long, R2 As Long
Dim i As Long
Dim myRange As Range
R1 = ActiveCell.Row
R2 = R1 + Selection.Rows.Count - 1
For i = R1 To R2
Set myRange = Worksheets(CStr(Cells(i, 3).Value)).Range("P:AD")
myRange.PrintOut
Next
End Sub
No.1ベストアンサー
- 回答日時:
一度重複しない顧客コードを取得し、そのデータを基に印刷を行なう。
Sub try()
Dim myDic As Object
Dim r As Range, rr As Range
Dim myRange As Range
Dim myKey As Variant
' Dictionaryオブジェクトを使います
Set myDic = CreateObject("Scripting.Dictionary")
' 選択したセル範囲と同行のB列をセット
Set rr = Intersect(Selection.EntireRow, Range("B:B"))
' ----------------------------------
' ここで重複する顧客コードはDictionaryでまとめてしまう。
For Each r In rr
If LenB(r.Value) > 0 Then ' B列に値があるかどうか
myDic(r.Value) = Empty
End If
Next
' -----------------------------------
' 重複のない顧客コードを元に印刷を行なう
For Each myKey In myDic.Keys
Set myRange = Worksheets(myKey).Range("P:AD")
myRange.PrintOut
Next
' -----------------------------------
Set myDic = Nothing
Set rr = Nothing
End Sub
【参考】
Dictionary オブジェクト
http://www.geocities.jp/cbc_vbnet/Scripting/dict …
Excel(エクセル) VBA入門:Dictionaryオブジェクトを利用する
http://www.eurus.dti.ne.jp/~yoneyama/Excel/vba/v …
ちょっと書き方は違いますが、ご参考になれば。
この回答への補足
ご丁寧にご説明を兼ねてご回答いただき、誠にありがとうございます。
一度、テストさせていただきました。Dictionaryオブジェクトは初心者の私にとって初めて使用するものですので、頑張って理解しながら読ませていただきました。
Set myRange = Worksheets(myKey).Range("P:AD")
の部分でエラーになってしまいます。Dictionaryオブジェクトの理解がまだ乏しいせいか、なぜエラーになってしまうのかが、大変申し訳ないのですが、わからないのです。頼りっきりで申し訳ないですが、よろしくお願いいたします。
No.5
- 回答日時:
#4です。
B列であっているのなら
>Set myRange = Worksheets(myKey).Range("P:AD")
Set myRange = Worksheets(Cstr(myKey)).Range("P:AD")
です。
説明文ではB列で、マクロコードはC列になっておりまして、ややこしくすみませんでした。実際はC列で、必要な部分だけ変えてさせていただきました。また新たなマクロを勉強でき、かつ仕事もスムーズにこなせるようになり、とても感謝しています。
ご丁寧かつ迅速にご回答いただき誠にありがとうございました。今回教わりましたマクロも次からは、自分でも使えるようにしていきたいと思っております。
No.4
- 回答日時:
#1です。
>Set myRange = Worksheets(myKey).Range("P:AD")
>の部分でエラーになってしまいます。
シート名が
>B列のコードと同じコード名のシートを印刷するという手順になります。
と言う事から顧客コードで行なってますが、提示されたコードの
>Set myRange = Worksheets(CStr(Cells(i, 3).Value)).Range("P:AD")
でいくとC列(顧客名)なのでしょうか?
もしそうであれば#1のコードの
>Set rr = Intersect(Selection.EntireRow, Range("B:B"))
を
Set rr = Intersect(Selection.EntireRow, Range("C:C"))
とC列に変更して下さい。
No.3
- 回答日時:
#1です。
一応Dictionaryオブジェクトのサンプル(になればいいですが)
Sub try2()
Dim myDic As Object
Dim myKey As Variant
Dim st As String
Set myDic = CreateObject("Scripting.Dictionary")
myDic("みかん") = Empty ' みかん を追加
myDic("りんご") = Empty ' りんご を追加
myDic("すいか") = Empty ' すいか を追加
For Each myKey In myDic.Keys
st = st & vbLf & myKey
Next
MsgBox st
myDic("みかん") = Empty ' みかん を追加
myDic("すいか") = Empty ' すいか を追加
myDic("バナナ") = Empty ' バナナ を追加
st = ""
For Each myKey In myDic.Keys
st = st & vbLf & myKey
Next
MsgBox st
Set myDic = Nothing
End Sub
ご参考になれば。
No.2
- 回答日時:
こんにちは、
試していないので、どうか解りませんが、
以下のコードでどうでしょう。
試してみてください。
Dim shname As New Collection
Sub test1()
Dim n As Long
Dim R1 As Long, R2 As Long
Dim i As Long
Dim myRange As Range
R1 = ActiveCell.Row
R2 = R1 + Selection.Rows.Count - 1
For i = R1 To R2
if check(CStr(Cells(i, 3).Value) then
Set myRange = Worksheets(CStr(Cells(i, 3).Value)).Range("P:AD")
myRange.PrintOut
end if
Next
End Sub
Public Function check(sh As String) As Boolean
Dim i As Integer
For i = 1 To shname.Count
If shname.Item(i) = sh Then
check = False
Exit Function
End If
Next
shname.Add sh
check = True
End Function
ご丁寧に、かつ迅速なご回答ありがとうございました。また違ったマクロの組方として、とても勉強になりました。今回ご教授いただいた事も含め、今後さらに勉強を重ねていきたいと思っております。ありがとうございました。
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Visual Basic(VBA) 複数シートの複数列に入力されているデータを重複なしで抽出するVBAを作りたいです。 9 2022/06/17 10:33
- Visual Basic(VBA) コード名シートA列と集計シートA列のコードが一致したら、コード名シートA5からk12の範囲をコピーし 1 2022/08/29 23:46
- Visual Basic(VBA) 別シートのデータを参照して値を入れたい。 まとめデータシートのC列D列の値を商品一覧シートのコードが 7 2022/08/17 13:20
- Visual Basic(VBA) VBAで最新のデータを別シートに転記する方法をお教えください。 3 2022/04/07 19:20
- Visual Basic(VBA) 2つのシートの任意のセルの番号が一致したら、一致した行をコピーする VBA 2 2023/06/19 20:48
- Visual Basic(VBA) VBAで、シート間の転記するコードをFOR~NEXTで教えてください。 9 2023/04/30 20:04
- Visual Basic(VBA) VBAコードが作動せず、どこに問題があるのか教えて下さい。 3 2023/06/13 13:20
- Visual Basic(VBA) 複数csvを横に追加していくマクロについて 2 2023/04/25 09:19
- Visual Basic(VBA) VBA Userformで一部別シートに転記がしたいのですが 2 2023/05/24 13:08
- Visual Basic(VBA) VBAで質問ですが、皆さんはどの様に導き出しているのでしょうか? 6 2022/05/03 21:53
関連するカテゴリからQ&Aを探す
おすすめ情報
- ・漫画をレンタルでお得に読める!
- ・【大喜利】【投稿~11/12】 急に朝起こしてきた母親に言われた一言とは?
- ・好きな和訳タイトルを教えてください
- ・うちのカレーにはこれが入ってる!って食材ありますか?
- ・好きな「お肉」は?
- ・あなたは何にトキメキますか?
- ・おすすめのモーニング・朝食メニューを教えて!
- ・「覚え間違い」を教えてください!
- ・とっておきの手土産を教えて
- ・「平成」を感じるもの
- ・秘密基地、どこに作った?
- ・【お題】NEW演歌
- ・カンパ〜イ!←最初の1杯目、なに頼む?
- ・一回も披露したことのない豆知識
- ・これ何て呼びますか
- ・チョコミントアイス
- ・初めて自分の家と他人の家が違う、と意識した時
- ・「これはヤバかったな」という遅刻エピソード
- ・これ何て呼びますか Part2
- ・許せない心理テスト
- ・この人頭いいなと思ったエピソード
- ・牛、豚、鶏、どれか一つ食べられなくなるとしたら?
- ・あなたの習慣について教えてください!!
- ・ハマっている「お菓子」を教えて!
- ・高校三年生の合唱祭で何を歌いましたか?
- ・【大喜利】【投稿~11/1】 存在しそうで存在しないモノマネ芸人の名前を教えてください
- ・好きなおでんの具材ドラフト会議しましょう
- ・餃子を食べるとき、何をつけますか?
- ・あなたの「必」の書き順を教えてください
- ・ギリギリ行けるお一人様のライン
- ・10代と話して驚いたこと
- ・家の中でのこだわりスペースはどこですか?
- ・つい集めてしまうものはなんですか?
- ・自分のセンスや笑いの好みに影響を受けた作品を教えて
- ・【お題】引っかけ問題(締め切り10月27日(日)23時)
- ・大人になっても苦手な食べ物、ありますか?
- ・14歳の自分に衝撃の事実を告げてください
- ・架空の映画のネタバレレビュー
- ・「お昼の放送」の思い出
- ・昨日見た夢を教えて下さい
- ・ちょっと先の未来クイズ第4問
- ・【大喜利】【投稿~10/21(月)】買ったばかりの自転車を分解してひと言
- ・メモのコツを教えてください!
- ・CDの保有枚数を教えてください
- ・ホテルを選ぶとき、これだけは譲れない条件TOP3は?
- ・家・車以外で、人生で一番奮発した買い物
- ・人生最悪の忘れ物
- ・【コナン30周年】嘘でしょ!?と思った○○周年を教えて【ハルヒ20周年】
- ・あなたの習慣について教えてください!!
- ・都道府県穴埋めゲーム
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
sinカーブの表示のさせ方
-
フィルターかけた後、重複を除...
-
JANコードとPOSコードは同じ?
-
1日に1人がこなせるプログラム...
-
access2003 クエリSQL文に...
-
access2021 VBA メソッドまたは...
-
PreviewKeyDownイベントが2回...
-
変数名「cur」について
-
VBA リストボックス(複数条件...
-
VBAでファイルオープン後にコー...
-
1、Rstudioで回帰直線を求める...
-
python コードについて(初学者...
-
【VB6】実行ファイルとした後、...
-
フォームのテキストボックスが...
-
データバインドした値のコード...
-
ExcelVBAで「Shift_JIS(MS932)...
-
videopadについて
-
Excel-VBAで、Importをする方法
-
過剰なオブジェクト指向脳から...
-
画像を最背面にし、ブックを後...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
フィルターかけた後、重複を除...
-
JANコードとPOSコードは同じ?
-
1日に1人がこなせるプログラム...
-
JavaScriptの定数名が取り消し...
-
access2003 クエリSQL文に...
-
Nullの使い方が不正です。
-
sinカーブの表示のさせ方
-
access2021 VBA メソッドまたは...
-
IF文、条件分岐の整理方法
-
COBOLの文法
-
変数名「cur」について
-
Exel VBA 別ブックから該当デ...
-
【VB6】実行ファイルとした後、...
-
ペンダントライトのコードの色...
-
VBAでファイルオープン後にコー...
-
Excel VBA素人です。VBAで図形...
-
PreviewKeyDownイベントが2回...
-
ACCESSユニオンクエリでORDER B...
-
VB6のComboBox関連の書き方をVB...
-
Access DCountでの連番について
おすすめ情報