[[20050309022931]]　『複数のシートから検索結果が重複する行・・・』（ごんね）　ページの最後に飛ぶ

『複数のシートから検索結果が重複する行・・・』（ごんね）

夜遅くに、ややこしいタイトルですが
よろしくおねがいします。

「複数のシートから検索結果が重複する行の別の列を
　　別シートに表示さすには？」どうしたらいいでしょうか？

判りにくい表現ですいません。

具体的に表すと。

 ○社
 　　A　　　　B　　　　C　　　　D　　　E　　　　　F　　　
1　コード　　種別　　規格　　定価　　売価　　　原価　
2　10569　　　A　　　10　　　40　　　　33　　　28
3　961　　　　AA　　　　　　150　　　150　　　121
4　63480　　　C　　　　8　　1800　　　1200　　921
5　2618　　　ES　　　40　　　647　　　627　　　314

 ▲社
 　　A　　　　B　　　　C　　　　D　　　E　　　　　F　　　
 1　コード　　種別　　規格　　定価　　売価　　　原価　
 2　10569　　　あ　　　10　　　40　　　39　　　　32
 3　2618　　　　　　　　40　　647　　　601　　　415
 4　　17　　　　け　　　　　　150　　　150　　　121
 5　63480　　　し　　　　8　　1800　　1650　　　1269

この複数のシートからコードが重複する行の別の列を
別のシートに表示させて

 　　　A　　　　　B　　　C　　　　D　　　　　　E　　　　　F　　　　　　G
 1　コード　　規格　　定価　　○社売価　　○社原価　　▲社売価　　▲社原価
 2　10569　　　10　　　40　　　　33　　　　　28　　　　　39　　　　　32
 4　63480　　　　8　　1800　　　1200　　　　921　　　　1650　　　　1269
 5　2618　　　　40　　647　　　　627　　　　314　　　　　601　　　　415

のような表を作りたいのです。
尚、コードの数は各社3000個ぐらいあります。

過去ログのhttps://www.excel.studio-kazu.jp/や
https://www.excel.studio-kazu.jp/を見て考えてみたのですが、
どれを組み合わせていったら考えれば考えるほどわかりません。
明日の午前中までに完成させないといけないため
よろしくお願いします。

Excel2000
Windows2000

会社では、ネットに繋げる環境にないため
出勤までに回答していただけたら風邪も
治るぐらいうれしいです。

よろしくおねがいいたします。

 ばたばたっと作ったから、、？？かも？？
Option Explicit
Sub てすと()
Dim MyDic As Object
Dim MyA As Variant, MyB As Variant, MyAry() As Variant
Dim MyTitle As Variant
Dim MyKey As String
Dim i As Long, k As Long, n As Long, x As Long
Set MyDic = CreateObject("Scripting.Dictionary")
MyTitle = Array("コード", "規格", "定価", "○社売価", "○社原価", "▲社売価", "▲社原価")
With Worksheets("Sheet2")
    MyB = .Range("A2", .Range("A65536").End(xlUp)).Resize(, 6).Value
End With
For i = 1 To UBound(MyB, 1)
    MyKey = MyB(i, 1)
    If Not MyDic.Exists(MyKey) Then MyDic.Add MyKey, i
Next
With Worksheets("Sheet1")
    MyA = .Range("A2", .Range("A65536").End(xlUp)).Resize(, 6).Value
    ReDim MyAry(1 To UBound(MyA, 1), 1 To 7)
    For i = 1 To UBound(MyA, 1)
        MyKey = MyA(i, 1)
        If MyDic.Exists(MyKey) Then
            k = k + 1
            x = MyDic(MyKey)
            MyAry(k, 1) = MyA(i, 1)
            For n = 2 To 5
                MyAry(k, n) = MyA(i, n + 1)
            Next
            For n = 6 To 7
                MyAry(k, n) = MyB(x, n - 1)
            Next
        End If
    Next
End With
With Worksheets("Sheet3")
    .Cells.Clear
    .Range("A1:G1").Value = MyTitle
    .Range("A2").Resize(UBound(MyAry, 1), UBound(MyAry, 2)).Value = MyAry
End With
Erase MyA, MyB, MyAry, MyTitle
Set MyDic = Nothing
End Sub
（SoulMan）

早速に、ありがとうございます。
初心者ですいません。
これを、どう貼れば・・・いいのでしょか？

あっ、締め切りの日書き込み違いしてます。
明日じゃなくて今日のことです。

マクロ登録をして実行をしました。
シート3に

 コード　　規格　　定価　　○社売価　　○社原価　　▲社売価　　▲社原価
とだけ出ました。
どこを間違えて実行したのでしょうか？

出来ました。

 あせっていたため、シート名を間違えていました。
 本当に、ありがとうございました！！

早朝にもかかわらず、回答ありがとうございました。

応用してSheet3にでる列の項目を増やしてみましたが、

コード　　規格　　定価　　○社売価　　○社原価　　▲社売価　　▲社原価　　取引
と列の部分しかでませんでした。

 Sheet1、Sheet2の増やした項目の数値はどうすれば表すことができますか？
 そして、Sheet2にしかない項目もコードが一致すればSheet3に表すには？

あれこれ、してみましたがだめでした。

色々応用して使いたいと思っていますので
よろしくおねがいします。

 すみません。もう少し具体的にお願いします。。。
（SoulMan）

判りにくい表現ですいません。

具体的に表すと。

 ○社
 　　A　　　　B　　　　C　　　　D　　　E　　　　　F　　　G　
1　コード　　種別　　規格　　定価　　売価　　　原価　　　取引
2　10569　　　10　　　10　　　40　　　　33　　　28　　　　2
3　961　　　　15　　　　　　150　　　150　　　121　　　　1
4　63480　　　20　　　　8　　1800　　　1200　　921　　　　3
5　2618　　　　25　　　40　　　647　　　627　　　314　　　9

 ▲社
 　　A　　　　B　　　　C　　　　D　　　E　　　　　F　　　G　
 1　コード　　種別　　規格　　定価　　売価　　　原価　　単位　
 2　10569　　　あ　　　10　　　40　　　39　　　　32　　　5
 3　2618　　　　　　　　40　　647　　　601　　　415　　　2
 4　　17　　　　け　　　　　　150　　　150　　　121　　　10
 5　63480　　　し　　　　8　　1800　　1650　　　1269　　1

 この複数のシートからコードが重複する行の別の列を
 別のシートに表示させて

 　　　A　　　B　　C　　　　D　　　　E　　　　F　　　　　G　　　　H　　　I
 1　コード　規格　定価　　○社売価　○社原価　▲社売価　▲社原価　取引　単位
 2　10569　　10　　40　　　33　　　　28　　　　39　　　　32　　　2　　　5
 3　63480　　　8　1800　　1200　　　921　　　1650　　　1269　　　3　　10
 4　2618　　　40　647　　　627　　　314　　　　601　　　415　　　9　　　2

 の表を作りたいと思うのですが、あれこれいじってみたのですが、
 H・Iが表示されません。

 これからも、応用して使っていきたいと思うのでよろしくお願いします。

 おはようございます。
 補足させてください。
 H・Iが表示されないととは下のようにしかでないとい意味です。
 判りにくくてすみませんでした。

  ○社
 　　A　　　　B　　　　C　　　　D　　　E　　　　　F　　　G　
1　コード　　種別　　規格　　定価　　売価　　　原価　　　取引
2　10569　　　10　　　10　　　40　　　　33　　　28　　　　2
3　961　　　　15　　　　　　150　　　150　　　121　　　　1
4　63480　　　20　　　　8　　1800　　　1200　　921　　　　3
5　2618　　　　25　　　40　　　647　　　627　　　314　　　9

 ▲社
 　　A　　　　B　　　　C　　　　D　　　E　　　　　F　　　G　
 1　コード　　種別　　規格　　定価　　売価　　　原価　　単位　
 2　10569　　　あ　　　10　　　40　　　39　　　　32　　　5
 3　2618　　　　　　　　40　　647　　　601　　　415　　　2
 4　　17　　　　け　　　　　　150　　　150　　　121　　　10
 5　63480　　　し　　　　8　　1800　　1650　　　1269　　1

 この複数のシートからコードが重複する行の別の列を
 別のシートに表示させて

 　　　A　　　B　　C　　　　D　　　　E　　　　F　　　　　G　　　　H　　　I
 1　コード　規格　定価　　○社売価　○社原価　▲社売価　▲社原価　取引　単位
 2　10569　　10　　40　　　33　　　　28　　　　39　　　　32　　　2　　　5
 3　63480　　　8　1800　　1200　　　921　　　1650　　　1269　　　3　　10
 4　2618　　　40　647　　　627　　　314　　　　601　　　415　　　9　　　2

 と出したくて試行錯誤してみたのですが、
　下の表のようにH・Iの部分の列が表示されません。

　　　A　　　B　　C　　　　D　　　　E　　　　F　　　　　G　　　　H　　　I

 1　コード　規格　定価　　○社売価　○社原価　▲社売価　▲社原価　取引　単位
 2　10569　　10　　40　　　33　　　　28　　　　39　　　　32　　　　　　
 3　63480　　　8　1800　　1200　　　921　　　1650　　　1269　　　
 4　2618　　　40　647　　　627　　　314　　　　601　　　415

 判りにくくてすませんでした。
 よろしくおねがいいたします。

 おはようございます。。昨日はあれから寝てましたzzzzzm(__)m
多分、こんな感じでいいと思うけど、どうでしょうか？
Option Explicit
Sub てすと()
Dim MyDic As Object
Dim MyA As Variant, MyB, MyAry() As Variant
Dim MyTitle As Variant
Dim MyKey As String
Dim i As Long, k As Long, n As Long, x As Long
Set MyDic = CreateObject("Scripting.Dictionary")
MyTitle = Array("コード", "規格", "定価", "○社売価", "○社原価", "▲社売価", "▲社原価", "取引", "単位")
With Worksheets("Sheet2")
    MyB = .Range("A2", .Range("A65536").End(xlUp)).Resize(, 7).Value
End With
For i = 1 To UBound(MyB, 1)
    MyKey = MyB(i, 1)
    If Not MyDic.Exists(MyKey) Then MyDic.Add MyKey, i
Next
With Worksheets("Sheet1")
    MyA = .Range("A2", .Range("A65536").End(xlUp)).Resize(, 7).Value
    ReDim MyAry(1 To UBound(MyA, 1), 1 To 9)
    For i = 1 To UBound(MyA, 1)
        MyKey = MyA(i, 1)
        If MyDic.Exists(MyKey) Then
            k = k + 1
            x = MyDic(MyKey)
            MyAry(k, 1) = MyA(i, 1)
            For n = 2 To 5
                MyAry(k, n) = MyA(i, n + 1)
            Next
            For n = 6 To 7
                MyAry(k, n) = MyB(x, n - 1)
            Next
            MyAry(k, 8) = MyA(i, 7)
            MyAry(k, 9) = MyB(x, 7)
        End If
    Next
End With
With Worksheets("Sheet3")
    .Cells.Clear
    .Range("A1:I1").Value = MyTitle
    .Range("A2").Resize(UBound(MyAry, 1), UBound(MyAry, 2)).Value = MyAry
End With
Erase MyA, MyB, MyAry, MyTitle
Set MyDic = Nothing
End Sub
（SoulMan）

 もう一つおまけです。。
 >これからも、応用して使っていきたいと思うのでよろしくお願いします。
 こっちの方がわかりやすいかも？？です。。お試しください。。
Option Explicit
Sub てすと()
'*********************************************
'変数の宣言
Dim MyA As Variant, MyB, MyAry() As Variant
Dim MyTitle As Variant
Dim MyTbl As Range
Dim i As Long, k As Long, n As Long, x As Variant
'*****************************************************
'見出しの部分を作成
MyTitle = Array("コード", "規格", "定価", "○社売価", "○社原価", "▲社売価", "▲社原価", "取引", "単位")
'Sheet2のデータ範囲を変数に取得
With Worksheets("Sheet2")
    Set MyTbl = .Range("A2", .Range("A65536").End(xlUp))
    MyB = MyTbl.Resize(, 7).Value
End With
'Sheet1のデータ範囲を変数に取得
With Worksheets("Sheet1")
    MyA = .Range("A2", .Range("A65536").End(xlUp)).Resize(, 7).Value
    '配列MyAryを用意
    ReDim MyAry(1 To UBound(MyA, 1), 1 To 9)
    'MyAの上限までループ
    For i = 1 To UBound(MyA, 1)
        'Matchでキーになる位置を取得
        x = Application.Match(MyA(i, 1), MyTbl, 0)
        'エラーじゃなかったらMyAryに代入していく
        If Not IsError(x) Then
            k = k + 1
            MyAry(k, 1) = MyA(i, 1)
            For n = 2 To 5
                MyAry(k, n) = MyA(i, n + 1)
            Next
            For n = 6 To 7
                MyAry(k, n) = MyB(x, n - 1)
            Next
            MyAry(k, 8) = MyA(i, 7)
            MyAry(k, 9) = MyB(x, 7)
        End If
    Next
End With
'抽出先をクリアにして出力する
With Worksheets("Sheet3")
    .Cells.Clear
    .Range("A1:I1").Value = MyTitle
    .Range("A2").Resize(UBound(MyAry, 1), UBound(MyAry, 2)).Value = MyAry
End With
'変数の初期化
Erase MyA, MyB, MyAry, MyTitle
Set MyTbl = Nothing
End Sub
(SoulMan）

ありがとうございます。
無事完成しました。

応用編の解説していただけたら、助かります。
お願いいたします。

 こんばんは！あまり解説は得意ではないけど、一応私なりに
上のコードに入れておきました。
参考にしてください。。
（SoulMan）

　ありがとうございます。
　解説をつけていただき助かります。
　またまた、質問させてください。

 過去の事例を検索して探してやってみたのですが、
 思うように出来なくて質問させてください。

　　　A　　　B　　C　　　　D　　　　E　　　　F　　　　　G　　　　H　　　I

 1　コード　規格　定価　　○社売価　○社原価　▲社売価　▲社原価　取引　単位
 2　10569　　10　　40　　　33　　　　28　　　　39　　　　32　　　2　　　5
 3　63480　　　8　1800　　1200　　　921　　　1650　　　1269　　　3　　10
 4　2618　　　40　647　　　627　　　314　　　　601　　　415　　　9　　　2

　前回まで教えていただて、ここまで出来ました。

 ○社原価と▲社原価を比較して安い値の数字（またはセル）に色を
 つけるには、条件付き書式で列のひとつひとつに設定しなくては
 いけないのでしょうか？　範囲指定してみたりとしたのですが、
 出来ませんでした。
 よろしくおねがいします。

 E列とG列の比較でよろしいのでしょうか？
あまりぱっとしませんが、、どうでしょうか？
Option Explicit
Sub てすと()
Dim C As Range
Dim MyTbl As Range
Set MyTbl = Range("E2", Range("E65536").End(xlUp))
MyTbl.Interior.ColorIndex = xlNone
MyTbl.Offset(, 2).Interior.ColorIndex = xlNone
For Each C In MyTbl
    If C.Value < C.Offset(, 2).Value Then
        C.Interior.ColorIndex = 3
    ElseIf C.Value > C.Offset(, 2).Value Then
        C.Offset(, 2).Interior.ColorIndex = 3
    End If
Next
Set MyTbl = Nothing
End Sub
あれ？？よく読むと条件付き書式のことでしょうか？
E2の条件付き書式の数式が
=G2>E2
G2のの条件付き書式の数式が
=G2<E2
と入力してそれぞれ書式を必要数コピーされてはどうでしょうか？
（SoulMan）

コメント返信：

[ 一覧(最新更新順) ]

[[20050309022931]] 『複数のシートから検索結果が重複する行・・・』（ごんね） ページの最後に飛ぶ

[[20050309022931]]　『複数のシートから検索結果が重複する行・・・』（ごんね）　ページの最後に飛ぶ