ＩＮＤＥＸ ＭＡＴＣＨ ＶＬＯＯＫＵＰ関数について

質問

https://box.yahoo.co.jp/guest/viewer?sid=box-l-a5gsu4qr63g4fugtyh7nt7sdti-1001&uniqid=ca100b6c-dfc4-4ff7-8e1e-8d11c4d28154&viewtype=detail

こちらを見て頂きたいのですが、

元となるブック、表示したいブックが別々のブックとなります。

棚番等を表示したいブックの列に表示させたいのですが、
関数を使って表示することは可能でしょうか？

表示さえ出来れば、どのような形でも良いのですが、元となるブックに関しての

変更はグループ会社で使用しているため、出来ないのですが、
表示したいブックに関しては変更可能なので、何か良いアイデアやアドバイス、もしくは

表示できるのであれば、関数を教えてほしいです。

宜しくお願い致します。

回答No.19

eden3616 · ベストアンサー

(1)出力されましたoutput.txtのデータで【取得処理】のC列のカウント値が6行である事

〉これは00-0000や00-000や（00-0000）、（00-000）
のパターンがあるのですが、これは大丈夫なのでしょうか？

→問題ありません。ここで言いたかったのは、output.txtの出力データは一つの商品コードにつき、倉庫Aで3行、倉庫Bで3行の計6行取得されます。
(各列の1.2.3行目と増えるにつれて、複数行にデータが入っている場合は半角スペースで結合していってますので、倉庫A.Bの3行目が最終の取得されたデータになります。)

(3)【出力処理】の商品名（D列）に「no hit」と入っている商品コードが実際の表示ブックA列に無い事
を確認致しました。

〉これは、一応在庫表に乗っている全てのコードを表示ブックに載せているつもりだったのですが、
〉B1217 no hit（3004.3005行目）エクセルの14745.14746行目は原因がわからないです。

→今はデータを確認していないませんが、B1217のコードが表示先のA列に存在しなければ、no hitとなります。
存在しない理由は本件と関係ないので、お答えしかねます。
存在していて、データを取得されてるのに出力されていなければ、まだ問題があると言うことになります。

〉逆に nohitで棚番があるものは、載せないといけないものなので、これを見ながら訂正していこうとおもいます。

そういった用途でログデータを活用いただけるのであれば幸いです。
お伝えしておりませんでしたが、
logput=1を0にすれば、ログデータを出力しなくなります。

〉今実際の在庫表で実際の表示したいシートで試してここまで
〉出れば完璧で想像以上に仕上がっており、これで逆にチェックが出来る場合もあると言うことですよね。

はい、照らし合わせお願いします。

〉とても素晴らしい方にここまでお付き合いして頂いて本当に感謝と申し訳なかったです。
〉こんなことが出来る事も知らなかったです。。
〉見て頂いた通り、本当にベースとなるものが、つくり方が悪いので、この数年、とても使いづらかったので、教えてくださって本当に親切な方に見てもらうことができて光栄です。

決められた様式、条件に基づいて繰り返し処理することはマクロ(プログラム)にとって得意分野ですので、量が膨大であっても初期構築さえ出来れば長く仕事で効率化が図られます。

〉金も払わなくても大丈夫なものなのかも、少し思ってしまいます。
〉色々アンサーも巡って調べたりもしたのですが、ここまで教えてくださる方はネット上でみたことがありません。
〉本当にお時間を無駄にしてしまい、申し訳ございませんでした。

無駄ではありませんよ。こちらも手際が悪く雑多な部分もありますので、ご質問者様のやる気が解決に繋がったかと存じます。
私も問題点の先読みなど、色々参考になりました。

長々とお付き合い有り難うございました。
本件について、また問題点がありましたら例のヒントにでもどうぞ。

お礼

お礼を入れたつもりが入ってなかったようです。

今回は本当にありがとうございました。

助かりました。

もう一つ実は教えていただきたいことがあるのですが、UPしてもよろしいでしょうか？

回答No.8

eden3616

コードを修正しましたので全て差し換えてください。

>サンプルに記載のある倉庫Ａ、Ｂは分かり易く書いただけで、実際の在庫表には記載はしておりません。

No2の想定・仕様について実データで行う際に内容に問題が無いかを精査してください。
この考え（想定）のもと作成しております。
「(4)AR列はAまたはBが記載されている場合のみ取得」
という仕様で作成しておりましたので、取得できなかったものと考えられます。

(1)B列がコードごとに結合
(2)6行結合：1.2.3行目が倉庫A、4.5.6行目が倉庫B
(3)9行結合：1.2.3行目が倉庫A、7.8.9行目が倉庫B
(4)12行結合：1.2.3行目が倉庫A、10.11.12行名が倉庫B
現在は上記条件により、B列結合された範囲の頭3行が倉庫A、尻3行が倉庫Bという共通の条件で処理しております。

No2の「■想定・仕様」のうち変更箇所を再度定義致します。

(1)は表示ブックのA列にコードが入っている箇所のみ表示するように変更。
　→A列のコードが取得元のB列の値と完全一致している必要があります
(2)は変わらず、商品コードは結合されている必要があります。
　→つまり別会社で作成元のデータに結合漏れがあれば検索範囲から外れることになります。
(3)上記仕様変更にともない、頭、尻3行がA、B倉庫となりますので重複しないものとなります。
(4)上記仕様変更により、頭、尻3行がA、B倉庫として取得します。
　→もし1グループ5行が存在してしまうと、真ん中の3行目がA、Bどちらにも重複します
(5)取得元のブックが異なりますので、元ブックの全シートが対象になります
　→極力取得元のブックには不要なシート（サンプルのSheet3などは外してください
　（一応、Sheet3のようにB列に何も含まれていないと除外する処理をいれています）

>もし可能であれば、もう一つ共通していることは、サンプルブックの通りのセル色となります。

可能ですが、上記(4)の条件で取得するため色での取得判定は処理に含めておりません。

以上再度ご確認ください。

■VBAコード

Option Explicit

Sub 集約()
'(1)型宣言
Dim tar_o As Object
Dim bas_f As String, bas_b As Workbook
Dim i As Long, j As Long, cnt As Long
Dim r_min As Integer, r_max As Integer
Dim t_min As Integer, t_max As Integer
Dim data(10000, 7) As String
Dim bk_code As String, bk_meisho As String, bk_souko As String
Dim hit As Long, flag As Integer
'(2)定数設定
Set tar_o = ThisWorkbook.ActiveSheet
bas_f = Application.GetOpenFilename("Excel ブック,*.xls;*.xlsx;*.xlsm")
If bas_f = "False" Then MsgBox "キャンセルされました": Exit Sub
cnt = -1
Application.ScreenUpdating = False
For i = 1 To Workbooks.Count
If Workbooks(i).Name = Dir(bas_f) Then
Set bas_b = Workbooks(i)
flag = 1
Exit For
End If
Next i
If flag = 0 Then Set bas_b = Workbooks.Open(Filename:=bas_f, ReadOnly:=True)
Debug.Print bas_b.Name
Debug.Print tar_o.Name
'(3)取得処理
For i = 1 To Sheets.Count
With bas_b.Sheets(i)
r_min = 8
r_max = .Range("B" & .Rows.Count).End(xlUp).Row
If r_min < r_max Then
.Activate
Debug.Print "sheet = " & .Name
t_min = r_min
Do While .Range("B" & t_min).MergeCells
.Range("B" & t_min).Select
t_min = Selection(1).Row
t_max = Selection(Selection.Count).Row
Debug.Print t_min & "-" & t_max
For j = t_min To t_max
If .Range("E" & j) <> "" Then
bk_meisho = .Range("E" & j)
Exit For
End If
Next j
For j = t_min To t_max
If .Range("B" & j) <> "" Then bk_code = .Range("B" & j)
If j = t_min Or j - t_min = 3 Then
bk_souko = (j - t_min) / 3
cnt = cnt + 1
End If
If j < t_min + 3 Or t_max - 3 < j Then
data(cnt, 0) = .Name
data(cnt, 1) = bk_code
data(cnt, 2) = bk_meisho
data(cnt, 3) = bk_souko
If .Range("AE" & j) <> "" Then data(cnt, 4) = data(cnt, 4) & .Range("AE" & j) & " "
If .Range("AF" & j) <> "" Then data(cnt, 5) = data(cnt, 5) & .Range("AF" & j) & " "
If .Range("AG" & j) <> "" Then data(cnt, 6) = data(cnt, 6) & .Range("AG" & j) & " "
End If
Next j
t_min = t_max + 1
Loop
End If
End With
Next i
Debug.Print "■取得完了"
If flag = 0 Then bas_b.Close
'(4)データ出力
With tar_o
tar_o.Activate
For i = 0 To cnt
hit = wfMatch(data(i, 1), Range("A:A"))
If hit > 0 Then
Debug.Print "i=" & i & " , hit=" & hit & " / " & data(i, 1)
If data(i, 3) = "0" Then
.Range("AD" & hit & ":AF" & hit).ClearContents
Debug.Print data(i, 3) & "_" & data(i, 4) & "/" & data(i, 5) & "/" & data(i, 6)
If data(i, 4) <> "" Then .Range("AD" & hit) = Left(data(i, 4), Len(data(i, 4)) - 1)
If data(i, 5) <> "" Then .Range("AE" & hit) = Left(data(i, 5), Len(data(i, 5)) - 1)
If data(i, 6) <> "" Then .Range("AF" & hit) = Left(data(i, 6), Len(data(i, 6)) - 1)
Else
.Range("AG" & hit).ClearContents
Debug.Print data(i, 3) & "_" & data(i, 4)
If data(i, 4) <> "" Then .Range("AG" & hit) = Left(data(i, 4), Len(data(i, 4)) - 1)
End If
End If
Next i
End With
Debug.Print "■出力完了"
'(5)終了処理
Application.ScreenUpdating = True
Set tar_o = Nothing
Set bas_b = Nothing
MsgBox "終了"
End Sub

Function wfMatch(word As String, tar As Range) As Long
On Error GoTo era
wfMatch = WorksheetFunction.Match(word, tar, 0)
Exit Function
era:
wfMatch = 0
End Function

補足

何度もすいません。本当にありがとうございます。

実行したところ、エラーが出て実行時エラー９
インデックスが有効範囲にありませんとでてしまいました。

デバックを押すと
With bas_b.Sheets(i)

ここの部分が黄色くなっておりました。

ここはどのような意味なのでしょうか？

回答No.7

eden3616

こちらのサンプルブックを用いてのテスト動作では問題なく取得できますので、
サンプルデータの様式、内容と本番のデータに差異が無いか再度確認する必要があります。

>試してみたのですが、すぐ終了と出てしまって、何も変化がなかったのですが、
>元となるブックが在庫表として、
>サンプルブックの表示したいブック（シート1）に頂いたコードを入れて、

「表示先のブック」であればシート、標準モジュールのどちらにコードを記載して頂いても構いません。

>マクロ→集約→実行→ファイルを開くで在庫表を指定したのですが、
>エラーも何も出ず、終了となってしまうのですが、
>原因わかりますでしょうか？

「終了」と表示されているのであればマクロが動作はしております。
内容が表示されていない原因を掴むには情報が不足しております。

マクロを実行後に、「Ａｌｔ+Ｆ11」で「Micosoft Visual Basic」を開き、
「イミディエイトウィンドウ」に表示されている文字をご提示お願いします。
（選択して頂いて右クリック→コピーが可能です）
イミディエイトウィンドウが表示されていない場合は、
「表示→イミディエイトウィンドウ」または「Ｃｔｒｌ+Ｇ」で表示してください。

また、

https://db.tt/tYpXhIyB
上記ファイルの「サンプルブック」にて、「表示したいブック（シート1） (2)」を表示した状態で
マクロを実行して、「サンプルブック」を指定してください。
これでサンプルブックの左から４つ目のシート「表示したいブック（シート1） (2)」の
ＡＤ～ＡＧ列に値が表示されるか確認願います。

>在庫表はネットワークサーバー上にあり、いつも読み取り専用で開いている状態なのですが、それが原因でしょうか？

こちらの環境にて元のブックをネットワークサーバー上に置き、読み取り専用で開いた状態で
表示したいブック・シートを選択した状態で実行しましたが正常動作いたしました。
この場合、ファイルの場所や状態は関係ないと思います。

追記＿＿＿＿＿

再度の確認ですが、行いたいことは
表示したいブック・シートのＡ列に既に商品コードが入っており、
元になるブックの各シート（複数）のＢ列から上記商品コードと一致する場合の
倉庫Ａ、Ｂを振り分けた形で値を取得して表示するということであってますか？

補足

大変申し訳ございません。

内容を見ていたのですが、追記の部分、私の説明が悪く、申し訳ないのですが、サンプルに記載のある倉庫Ａ、Ｂは分かり易く書いただけで、実際の在庫表には記載はしておりません。

申し訳ございません。

サンプルブックの通り、元となる在庫表はB列がコードごとに結合されており、結合セルが最低6行から最高12行あります。

並び順としては、6行結合されたコードは1.2.3行目が倉庫A、4.5.6行目が倉庫Bです。

9行結合されたコードは、1.2.3行目が倉庫A、7.8.9行目が倉庫Bです。

12行結合されたコードは、1.2.3行目が倉庫A、10.11.12行名が倉庫Bとなります。

ここの並び順は共通となっております。

やりたいことは、表示したいブック、シートAの列は既に商品コードが入っております。

元になる在庫表ブックの各シートB列と表示したいブック、シートのA列が一致した商品コードのAE-AGの値を表示したいと言った感じです。

もし可能であれば、もう一つ共通していることは、サンプルブックの通りのセル色となります。

倉庫Aは黄色、倉庫Bは緑です。（意味なければすいません）

回答No.6

eden3616

失礼しました。

>元のデータが入っているブックのシートは8シートあり、
>常に開いている状態です。

元ブックが開かれている場合はそのブックから、開かれていなければ新規でブックを開く処理に変更しました。
（既に開かれている場合でも対象になる元ブックを指定するために、ファイルを開くダイアログは表示されます）

最新のコードを以下に記載致します。

■VBAコード
Option Explicit

Sub 集約()
'(1)型宣言
Dim tar_o As Object
Dim bas_f As String, bas_b As Workbook
Dim i As Long, j As Long, cnt As Long
Dim r_min As Integer, r_max As Integer
Dim t_min As Integer, t_max As Integer
Dim data(10000, 7) As String
Dim bk_code As String, bk_meisho As String, bk_souko As String
Dim hit As Long, flag As Integer
'(2)定数設定
Set tar_o = ThisWorkbook.ActiveSheet
bas_f = Application.GetOpenFilename("Excel ブック,*.xls;*.xlsx;*.xlsm")
If bas_f = "False" Then MsgBox "キャンセルされました": Exit Sub
cnt = -1
Application.ScreenUpdating = False
For i = 1 To Workbooks.Count
If Workbooks(i).Name = Dir(bas_f) Then
Set bas_b = Workbooks(i)
flag = 1
Exit For
End If
Next i
If flag = 0 Then Set bas_b = Workbooks.Open(Filename:=bas_f, ReadOnly:=True)
Debug.Print bas_b.Name
Debug.Print tar_o.Name
'(3)取得処理
For i = 1 To Sheets.Count
With bas_b.Sheets(i)
r_min = 8
r_max = .Range("B" & .Rows.Count).End(xlUp).Row
If r_min < r_max Then
.Activate
Debug.Print "sheet = " & .Name
t_min = r_min
Do While .Range("B" & t_min).MergeCells
.Range("B" & t_min).Select
t_min = Selection(1).Row
t_max = Selection(Selection.Count).Row
Debug.Print t_min & "-" & t_max
For j = t_min To t_max
If .Range("E" & j) <> "" Then
bk_meisho = .Range("E" & j)
Exit For
End If
Next j
For j = t_min To t_max
If .Range("B" & j) <> "" Then bk_code = .Range("B" & j)
If .Range("AR" & j).MergeCells Then
If .Range("AR" & j) <> "" Then
bk_souko = .Range("AR" & j): cnt = cnt + 1
End If
data(cnt, 0) = .Name
data(cnt, 1) = bk_code
data(cnt, 2) = bk_meisho
data(cnt, 3) = bk_souko
If .Range("AE" & j) <> "" Then data(cnt, 4) = data(cnt, 4) & .Range("AE" & j) & " "
If .Range("AF" & j) <> "" Then data(cnt, 5) = data(cnt, 5) & .Range("AF" & j) & " "
If .Range("AG" & j) <> "" Then data(cnt, 6) = data(cnt, 6) & .Range("AG" & j) & " "
End If
Next j
t_min = t_max + 1
Loop
End If
End With
Next i
Debug.Print "■取得完了"
If flag = 0 Then bas_b.Close
'(4)データ出力
With tar_o
tar_o.Activate
For i = 0 To cnt
hit = wfMatch(data(i, 1), Range("A:A"))
If hit > 0 Then
Debug.Print "i=" & i & " , hit=" & hit & " / " & data(i, 1)
If data(i, 3) = .Range("AD1") Then
.Range("AD" & hit & ":AF" & hit).ClearContents
Debug.Print data(i, 3) & "_" & data(i, 4) & "/" & data(i, 5) & "/" & data(i, 6)
If data(i, 4) <> "" Then .Range("AD" & hit) = Left(data(i, 4), Len(data(i, 4)) - 1)
If data(i, 5) <> "" Then .Range("AE" & hit) = Left(data(i, 5), Len(data(i, 5)) - 1)
If data(i, 6) <> "" Then .Range("AF" & hit) = Left(data(i, 6), Len(data(i, 6)) - 1)
Else
.Range("AG" & hit).ClearContents
Debug.Print data(i, 3) & "_" & data(i, 4)
If data(i, 4) <> "" Then .Range("AG" & hit) = Left(data(i, 4), Len(data(i, 4)) - 1)
End If
End If
Next i
End With
Debug.Print "■出力完了"
'(5)終了処理
Application.ScreenUpdating = True
Set tar_o = Nothing
Set bas_b = Nothing
MsgBox "終了"
End Sub

Function wfMatch(word As String, tar As Range) As Long
On Error GoTo era
wfMatch = WorksheetFunction.Match(word, tar, 0)
Exit Function
era:
wfMatch = 0
End Function

補足

ありがとうございます。

試してみたのですが、すぐ終了と出てしまって、何も変化がなかったのですが、

元となるブックが在庫表として、
サンプルブックの
表示したいブック（シート1）に頂いたコードを入れて、
マクロ→集約→実行→ファイルを開くで在庫表を指定したのですが、エラーも何も出ず、終了となってしまうのですが、
原因わかりますでしょうか？

在庫表はネットワークサーバー上にあり、いつも読み取り専用で開いている状態なのですが、それが原因でしょうか？

回答No.5

eden3616

遅くなりました。

>サンプルで言うとA列の商品コードがエクセルブックデータ管理（サンプルで言うと表示したいブック（シート1）の中の商品コードと一致すれば、AD-AGに棚板を転記したいと言った感じです。

との事ですので、表示したいブックのC、D列は無視してA列の商品コードで元になるブックの値を検索してAD～AGに出力します。

※注意※＿＿＿＿＿＿＿＿＿＿＿＿
このコードは初めに元になるブックのデータを一気に取得してから、該当するデータを出力していますので、
取得する量（商品コードの数×2が約10000件以上ですとエラーになります）

■実装方法
いままでのコードは破棄して頂いて、
以下のVBAコードを「表示したいブック」の標準モジュールに登録してください。
「表示したいブック」の「表示したいシート」を表示した状態でマクロの「集約」を実行してください。
「元となるブック」を開くダイアログが表示されますので、「元となるブック」を指定してください。
（元となるブックにある全シートを取得対象として、商品コードで検索をします）

■VBAコード
Option Explicit

Sub 集約()
'(1)型宣言
Dim tar_o As Object
Dim bas_f As String, bas_b As Workbook
Dim i As Long, j As Long, cnt As Long
Dim r_min As Integer, r_max As Integer
Dim t_min As Integer, t_max As Integer
Dim data(10000, 7) As String
Dim bk_code As String, bk_meisho As String, bk_souko As String
Dim hit As Long
'(2)定数設定
Set tar_o = ThisWorkbook.ActiveSheet
bas_f = Application.GetOpenFilename("Excel ブック,*.xls;*.xlsx;*.xlsm")
If bas_f = "False" Then MsgBox "キャンセルされました": Exit Sub
cnt = -1
Application.ScreenUpdating = False
'(3)取得処理
Set bas_b = Workbooks.Open(Filename:=bas_f, ReadOnly:=True)
For i = 1 To Sheets.Count
With bas_b.Sheets(i)
r_min = 8
r_max = .Range("B" & .Rows.Count).End(xlUp).Row
If r_min < r_max Then
.Activate
Debug.Print "sheet = " & .Name
t_min = r_min
Do While .Range("B" & t_min).MergeCells
.Range("B" & t_min).Select
t_min = Selection(1).Row
t_max = Selection(Selection.Count).Row
Debug.Print t_min & "-" & t_max
For j = t_min To t_max
If .Range("E" & j) <> "" Then
bk_meisho = .Range("E" & j)
Exit For
End If
Next j
For j = t_min To t_max
If .Range("B" & j) <> "" Then bk_code = .Range("B" & j)
If .Range("AR" & j).MergeCells Then
If .Range("AR" & j) <> "" Then
bk_souko = .Range("AR" & j): cnt = cnt + 1
End If
data(cnt, 0) = .Name
data(cnt, 1) = bk_code
data(cnt, 2) = bk_meisho
data(cnt, 3) = bk_souko
If .Range("AE" & j) <> "" Then data(cnt, 4) = data(cnt, 4) & .Range("AE" & j) & " "
If .Range("AF" & j) <> "" Then data(cnt, 5) = data(cnt, 5) & .Range("AF" & j) & " "
If .Range("AG" & j) <> "" Then data(cnt, 6) = data(cnt, 6) & .Range("AG" & j) & " "
End If
Next j
t_min = t_max + 1
Loop
End If
End With
Next i
Debug.Print "■取得完了"
bas_b.Close
'(4)データ出力
With tar_o
For i = 0 To cnt
hit = wfMatch(data(i, 1), Range("A:A"))
If hit > 0 Then
Debug.Print "i=" & i & " , hit=" & hit & " / " & data(i, 1)
If data(i, 3) = .Range("AD1") Then
.Range("AD" & hit & ":AF" & hit).ClearContents
Debug.Print data(i, 3) & "_" & data(i, 4) & "/" & data(i, 5) & "/" & data(i, 6)
If data(i, 4) <> "" Then .Range("AD" & hit) = Left(data(i, 4), Len(data(i, 4)) - 1)
If data(i, 5) <> "" Then .Range("AE" & hit) = Left(data(i, 5), Len(data(i, 5)) - 1)
If data(i, 6) <> "" Then .Range("AF" & hit) = Left(data(i, 6), Len(data(i, 6)) - 1)
Else
.Range("AG" & hit).ClearContents
Debug.Print data(i, 3) & "_" & data(i, 4)
If data(i, 4) <> "" Then .Range("AG" & hit) = Left(data(i, 4), Len(data(i, 4)) - 1)
End If
End If
Next i
End With
Debug.Print "■出力完了"
'(5)終了処理
Application.ScreenUpdating = True
Set tar_o = Nothing
Set bas_b = Nothing
MsgBox "終了"
End Sub

Function wfMatch(word As String, tar As Range) As Long
On Error GoTo era
wfMatch = WorksheetFunction.Match(word, tar, 0)
Exit Function
era:
wfMatch = 0
End Function

補足

もう一つご指示頂いていた、イミディエイトですが、
401-409
410-415
416-421
422-424
425-433
434-442
443-451
452-460
461-466
467-472
473-481
482-490
491-496
497-502
503-505
506-511
512-520
521-529
530-538
539-550
551-559
560-568
569-577
578-583
584-586
587-595
596-607
608-616
617-628
629-631
632-640
641-646
647-655
656-667
668-670
671-676
677-682
683-688
689-691
692-697
698-706
707-715
716-718
719-724
725-733
734-742
743-751
752-760
761-769
770-775
776-784
785-793
794-802
803-811
812-817
818-823
824-829
830-832
833-841
842-850
851-859
860-871
872-883
884-892
893-901
902-910
911-916
917-925
926-934
935-943
944-952
953-961
962-967
968-973
974-979
980-985
986-988
989-997
998-1009
1010-1021
1022-1033
1034-1045
1046-1057
1058-1066
1067-1069
1070-1075
1076-1078
1079-1084
1085-1090
1091-1096
1097-1105
1106-1114
1115-1123
1124-1126
1127-1138
1139-1147
1148-1159
1160-1171
1172-1180
1181-1189
1190-1201
1202-1210
1211-1219
1220-1225
1226-1234
1235-1243
1244-1252
1253-1261
1262-1270
1271-1282
1283-1294
1295-1300
1301-1309
1310-1315
1316-1318
1319-1327
1328-1339
1340-1351
1352-1360
1361-1369
1370-1375
1376-1384
1385-1390
1391-1399
1400-1408
1409-1417
1418-1426
1427-1429
1430-1435
1436-1441
1442-1450
1451-1459
1460-1468
1469-1477
1478-1483
1484-1486
1487-1495
1496-1507
1508-1510
1511-1516
1517-1525
1526-1528
1529-1537
1538-1543
1544-1549
1550-1555
1556-1561
1562-1564
1565-1570
1571-1579
1580-1588
1589-1594
1595-1600
1601-1609
1610-1612
1613-1618
1619-1621
1622-1630
1631-1633
1634-1645
1646-1648
1649-1660
1661-1666
1667-1675
1676-1684
1685-1693
1694-1702
1703-1705
1706-1714
1715-1723
1724-1735
sheet = 02タイヤ 17インチ
8-13
sheet = 02タイヤ 18インチ
8-13
14-19
sheet = 02タイヤ 19インチ
8-16
17-28
29-40
41-52
53-64
65-70
71-79
80-88
89-97
98-106
107-112
113-118
119-127
sheet = 02タイヤ 20インチ-21インチ
8-13
sheet = 02タイヤ 22インチ-26インチ
8-13
sheet = 02タイヤ スタッドレス
8-16
17-25
26-31
sheet = 出荷集計用

となっておりました。

回答No.4

eden3616

サンプルより同一ブックの別シートに出力するように構成しております。

サンプルのデータで作成していますので、
ブックの構成が異なっているようなので、正常に動作しません。

頂いた情報で再構成致します。

補足

宜しくお願い致します。。すいません。

回答No.3

eden3616

回答No2について修正があります。

VBAコード内の「'(2)定数設定」において以下の箇所ですが、
Set tar_s = Sheets("表示したいブック（シート1） (2)")

正しくは以下の通りです
Set tar_s = Sheets("表示したいブック（シート1）")

テスト実行時に元の出力先シートをコピーして実行したため、
「表示したいブック（シート1）」をコピーして作成された
「表示したいブック（シート1） (2)」に対して出力を行っておりました。
このため、サンプルと異なったシート名で設定しておりました。

存在しないシート名を設定されますと、「インデックスが有効範囲にありません」というエラーが表示されます。
サンプルのデータで利用される場合は修正願います。

※）
実作業で利用される場合はNo2の「■実装方法」の(4)に記載しておりますとおり、
実際に利用されるシート名を設定してください。

補足

勘違いしておりました。

Set tar_s = Sheets("データ管理.xlsm（商品マスタ） (2)")

ここを

Set tar_s = Sheets("商品マスタ")

としましたら、エラーは出なかったのですが、

商品マスタのデータが全て消えてしまいました。。

回答No.2

eden3616

以下の想定のもと仕様を定義して作成しています。
定義にそぐわないフォーマットの場合正しく処理が出来ません。
サンプルのデータではOffce2007で正常動作を確認しています。
細かいエラー対策は行っていません。
サンプルにて「表示したいブック」の商品コード「00-0001」「00-0002」を再度確認してください。

■想定・仕様
◆マスタブックについて
(1)B8から開始
(2)商品コードの塊は必ず行方向に結合
（8行目から結合されていないセルまでを取得範囲としています）
(3)1つの商品コードの塊で「倉庫Ａ・Ｂ」の塊が2回以上出ない
（2個以上ある場合はまとめる作業が必要になります）
(4)AR列はAまたはBが記載されている場合のみ取得
（商品コード「00-6666」の「倉庫Ｂ」が入っていないので無視されます）
(5)「表示したいブック」以外のシートを全て対象
（Sheet3対策で例外としてB列に何も含まれていないシートは除外しています）
◆表示したいブックについて
(6)各行を結合した場合は半角スペース「 」で結合
(7)4行目の黒背景色が不明なため、3行目から対象としています
　※変更する場合はコード内の以下の箇所の「3」を開始行に変更
　・(2)定数設定
　　tar_s.Rows("3:" & Rows.Count).Delete
　・(4)データ出力
　　j = 3 - 1
(8)出力先の3行目以降を行削除しています
　※値の削除をする場合は以下の「Delete」を「ClearContents」に変更
　・(2)定数設定
　　tar_s.Rows("3:" & Rows.Count).Delete

■実装方法
(1)「Alt+F11」でMicrosoft Visual Basicを開く
(2)「挿入→標準モジュール」を挿入
(3)VBAコードを貼付
(4)コード内の「'(2)定数設定」で以下の部分を出力先のシート名に設定してください
　Set tar_s = Sheets("表示したいブック（シート1） (2)")
(5)(1)を閉じて「集約」を実行

■VBAコード
Sub 集約()
'(1)型宣言
Dim tar_s As Worksheet
Dim i As Long, j As Long, cnt As Long
Dim r_min As Integer, r_max As Integer
Dim data(10000, 7) As String
Dim bk_code As String, bk_meisho As String, bk_souko As String
'(2)定数設定
Set tar_s = Sheets("表示したいブック（シート1） (2)")
cnt = -1
tar_s.Rows("3:" & Rows.Count).Delete
Application.ScreenUpdating = False
'(3)取得処理
For i = 1 To Sheets.Count
With Sheets(i)
r_min = 8
r_max = .Range("B" & .Rows.Count).End(xlUp).Row
If .Name <> tar_s.Name And r_min < r_max Then
.Activate
Debug.Print "sheet = " & .Name
t_min = r_min
Do While .Range("B" & t_min).MergeCells
.Range("B" & t_min).Select
t_min = Selection(1).Row
t_max = Selection(Selection.Count).Row
Debug.Print t_min & "-" & t_max
For j = t_min To t_max
If .Range("E" & j) <> "" Then
bk_meisho = .Range("E" & j)
Exit For
End If
Next j
For j = t_min To t_max
If .Range("B" & j) <> "" Then bk_code = .Range("B" & j)
If .Range("AR" & j).MergeCells Then
If .Range("AR" & j) <> "" Then
bk_souko = .Range("AR" & j): cnt = cnt + 1
End If
data(cnt, 0) = .Name
data(cnt, 1) = bk_code
data(cnt, 2) = bk_meisho
data(cnt, 3) = bk_souko
If .Range("AE" & j) <> "" Then data(cnt, 4) = data(cnt, 4) & .Range("AE" & j) & " "
If .Range("AF" & j) <> "" Then data(cnt, 5) = data(cnt, 5) & .Range("AF" & j) & " "
If .Range("AG" & j) <> "" Then data(cnt, 6) = data(cnt, 6) & .Range("AG" & j) & " "
End If
Next j
t_min = t_max + 1
Loop
End If
End With
Next i
Debug.Print "【取得完了】"
'(4)データ出力
j = 3 - 1
bk_code = ""
For i = 0 To cnt
If data(i, 1) <> bk_code Then
bk_code = data(i, 1)
j = j + 1
End If
Debug.Print data(i, 0) & "_" & data(i, 1) & " / " & data(i, 2) & " / " & data(i, 3) & "_" & data(i, 4) & " / " & data(i, 5) & " / " & data(i, 6)
With tar_s
.Range("A" & j) = data(i, 1)
.Range("C" & j) = data(i, 1)
.Range("D" & j) = data(i, 2)
If data(i, 3) = tar_s.Range("AD1") Then
If data(i, 4) <> "" Then .Range("AD" & j) = Left(data(i, 4), Len(data(i, 4)) - 1)
If data(i, 5) <> "" Then .Range("AE" & j) = Left(data(i, 5), Len(data(i, 5)) - 1)
If data(i, 6) <> "" Then .Range("AF" & j) = Left(data(i, 6), Len(data(i, 6)) - 1)
Else
If data(i, 4) <> "" Then .Range("AG" & j) = Left(data(i, 4), Len(data(i, 4)) - 1)
End If
End With
Next i
Debug.Print "【出力完了】"
'(5)終了処理
Application.ScreenUpdating = True
Set tar_s = Nothing
MsgBox "終了"
End Sub

補足

ありがとうございます。

インデックスが有効範囲にありませんと出てしまったのですが、表示したいブック名がデータ管理.xlsm
シート名が商品マスタとなっている場合、

Set tar_s = Sheets("データ管理.xlsm（商品マスタ） (2)")

これで良いのでしょうか？

元のデータが入っているブックはどこで設定しているのでしょうか？

元のデータが入っているブックのシートは8シートあり、
常に開いている状態です。

回答No.1

eden3616

各商品の行数が疎らであり、統一性がなさそうですので関数の範囲内で取得することは困難のようです。
VBAで各行の状態を判断してデータを取得して出力するほうがよさそうですね。

シート構成やフォーマットの様式・取得条件、出力結果の書式等何点か確認したい事柄もありますが、、、
サンプルより勝手に判断するとします。

表示したいブックの4行目「aaaaa」と5行目「bbbbb」って違っていませんか？
商品コードまたは商品名が一致したものを、そのまま持ってくる以外の持特別なルールがあれば記載願います。
表示したいブックの３行目からデーたを出力するものとしてマクロを作成してみます。

補足

ごめんなさい、文章が悪かったのかもしれません。

やりたいことは、元データとなるブック（在庫表）があるとして、その在庫表を元にして、

サンプルで言うとA列の商品コードがエクセルブックデータ管理（サンプルで言うと表示したいブック（シート1）の中の商品コードと一致すれば、AD-AGに棚板を転記したいと言った感じです。