[[20180405152857]]　『管理番号を検索して同じ行に転記するマクロ』（悩めるスズキ）　ページの最後に飛ぶ

『管理番号を検索して同じ行に転記するマクロ』（悩めるスズキ）

初めまして、マクロは出来上がっているものを少しいじることはありますが、
位置から組んだことがないので、いい組み方があれば教えていただけると嬉しいです。
よろしくお願いいたします。

シートが3枚あります。

・管理表
・単体一覧
・結果

《管理票》に売上等の一覧（形は下へ延びることはあるが基本一定）を全体で貼り付けると
《結果》に一部転記されています。

《単体一覧》でC2に管理番号を入れると
必要なデータを《管理票》から抜き出して計算を行い見れる仕様になっているのですが

その際に計算したデータを《単体一覧》から《結果》に追記したいです。
追記の際は現在入っているデータへ上書きして構いません。

単体一覧シート

・C2に管理番号を入力
・データが表示される
・追加データを入力する
・C11とD11に計算されたデータが表示される
・マクロ実行ボタンを押す

結果シート

《単体一覧》でマクロの実行ボタンを押すと
《単体一覧》で表示されたC11とD11のデータを
《結果》のB列で管理番号を探し、同じ行のQ列とT列に追記したい

・マクロ実行用の決定ボタンを設置します。
・単体一覧シートは、毎回同じものを使います。
（マクロ実行後にクリアボタンで初期化します）
・単体一覧シートには、一部のみクリアするマクロボタンを設置予定

何卒、よろしくお願いいたします

C11をQ列に転記
D11をT列に転記

＜使用 Excel：Excel2010、使用 OS：Windows7 ＞

 こんばんは　＾＾
回答ではありません。恐怖の憶測＆推測の。。。コード
なにかの参考にでも。。。ならないかも　コピーし別BOOKにて～必須です。(;^_^A
的外れでしたら、廃棄処分でお願い致します。
<< _ _ >>

 Option Explicit
'**********************************************************
Sub start()
    Dim sh02 As Worksheet
    Set sh02 = Worksheets("単体一覧")
    btn sh02
End Sub
Private Sub main()
    Dim master_key As Long, lastr As Long, i As Long
    Dim sh02 As Worksheet, sh03 As Worksheet
    Set sh02 = Worksheets("単体一覧")
    Set sh03 = Worksheets("結果")
    master_key = sh02.Range("C2")
    With sh03
        lastr = .Cells(.Rows.Count, 2).End(xlUp).Row
        For i = 1 To lastr
            If .Cells(i, 2) = master_key Then
                .Cells(i, 17) = sh02.Range("C11")
                .Cells(i, 20) = sh02.Range("D11")
            End If
        Next
    End With
    btndel sh02
End Sub
Private Sub btn(ByVal sh02 As Object)
    Dim br As Range
    Set br = sh02.Range("F3:G4")
    With sh02.Buttons.Add(br.Left, br.Top, br.Width, br.Height)
        .OnAction = "Module1.main"
        .Characters.Text = "BTN"
    End With
End Sub
Private Sub btndel(ByVal sh02 As Object)
    Dim btn As Object
    For Each btn In sh02.Buttons
        btn.Delete
    Next
End Sub

（隠居じーさん） 2018/04/05(木) 17:24

んと、Match関数で検索すると行番号が返ってきます。
（正確にはデータ群の何番目か）
それをどこかに保持または記録しておいて、
書き込むときに使えばいいと思います。

（まっつわん） 2018/04/05(木) 17:36

ちなみにマクロの実行ボタンはシート上に配置ですか？

（まっつわん） 2018/04/05(木) 17:37

隠居じーさん様

回答ありがとうございます。
さっそく試してみました。
別作業に戻らないとなので、簡単にしか試していないのですが

Private Sub btn(ByVal sh02 As Object)

    Dim br As Range
    Set br = sh02.Range("F3:G4")
    With sh02.Buttons.Add(br.Left, br.Top, br.Width, br.Height)
        .OnAction = "Module1.main"
        .Characters.Text = "BTN"
    End With
End Sub

こちらの部分はボタン出現だと思うのですが、固定で設置しているので
処理に支障が出ないのでしたら削除したいのですが大丈夫そうですかね？

他は
master_key = sh02.Range("C2")

エラーが出てしまっているようです。

すみません

現在の作業が終わりましたら、もう少ししっかり確認させていただきます。
また、ご質問させていただくかと思いますのでよろしくお願いいたします。
（悩めるスズキ） 2018/04/05(木) 17:42

まっつわんさん

ご質問ありがとうございます。

ボタンは単体一覧のE2：E3に転記とG2：G3にクリア

という形で設置してあります
（悩めるスズキ） 2018/04/05(木) 17:45

ボタンは、
ActiveXコントロールのボタンを使ってますか？

あと、Macth関数の方は解りました？

シート上で使う関数の一部がVBAで利用できます。
検索すればサンプルはいくらでも見つかるでしょうが、
応用となると、いきなりは難しいかもですね。

まぁ検索して調べてみてください。
検索が上手くなるのも脱初心者への一手です。

（まっつわん） 2018/04/05(木) 17:52

まっつわん様

ファームコントロールの方を使っています。

すみません。
Macth関数事態はわかりますがVBAへの転用がよくわかりません。

調べてはいますが、求めている方法の参考がなかなか見つけられませんね。

少しやり方を変えてみます
（悩めるスズキ） 2018/04/05(木) 17:57

https://kokodane.com/kan33.htm

こういうのを応用すればよいと思いますが？

http://www.atmarkit.co.jp/ait/articles/1506/19/news015.html
http://www.asahi-net.or.jp/~ef2o-inue/vba_o/sub05_800_030.html

（まっつわん） 2018/04/05(木) 18:53

Option Explicit

Sub 検索()

    Dim rngData As Range
    Dim rngNumber As Range
    Dim vixRow As Variant

    '前提条件の定義
    Set rngData = Worksheets("管理表").UsedRange
    Set rngNumber = Worksheets("単体一覧").Range("C2")

    'Match関数で検索
    vixRow = Application.Match(rngData.Columns(1), rngNumber, 0)
    If IsError(vixRow) = True Then Exit Sub

    '見つかった行の転記
    rngData(vixRow, 2).Resize(, 7).Copy
    rngNumber.Offset(1).PasteSpecial Transpose:=True
End Sub

Sub 計算結果の転記()

    Dim rngData As Range
    Dim rngNumber As Range
    Dim vixRow As Variant

        '前提条件の定義
    Set rngData = Worksheets("結果").UsedRange
    Set rngNumber = Worksheets("単体一覧").Range("C2")

    'Match関数で検索
    vixRow = Application.Match(rngData.Columns(2), rngNumber, 0)
    If IsError(vixRow) = True Then Exit Sub

    '転記
    rngData(vixRow, "Q").Value = rngNumber(9, 1).Value
    rngData(vixRow, "T").Value = rngNumber(10, 1).Value
End Sub

あれ、書いてから気づいた　orz
一連でやりたいんでいたっけ？
ま、参考になるでしょうということでm(_ _)m

（まっつわん） 2018/04/05(木) 19:19

＞エラーが出てしまっているようです。　　＾＾；
エラーの内容をアップしていただけますか。
＞管理番号を探し
でしたので数値で実験しました。
文字列でしょうか？
管理番号　＝　例　CB5100XZ
ボタンは　Startの実行を止め
mainを直接実行なり、配置済のボタンと連携するなりされると。
いいかもです。
mainの最後の
btndel sh02
もボタン全部消してしまいますので、削除してくださいね。^^;;;
ある程度作成されておられるなら
コードをアップされるともっと具体的なアドバイスが得られるかもしれませんですね。
すみません
ボタン出すのが楽しいだけのじーさんコードでした。
m(__)m

（隠居じーさん） 2018/04/05(木) 19:31

まっつわんさん

Match、値と範囲が逆では？

＾＾

（隠居じーさん） 2018/04/05(木) 21:45

＞Macth関数事態はわかりますがVBAへの転用がよくわかりません。
＞調べてはいますが、求めている方法の参考がなかなか見つけられませんね。

他の方への回答の使い回しですが、多少は参考になるかとおもいます。

いろんなアプローチがあるとおもいますが、新しいブック（シート）を用意して、以下のコードを標準モジュールにコードを張り付けたうえでステップ実行してみてください。

    Sub 一致するデータを探す()
        'テスト用データ生成
        Range("B1:D1").Value = Array("あ", "い", "う")
        Range("B2:D2").Value = Array("え", "お", "か")
        Range("B3:D3").Value = Array("き", "く", "け")
        Range("B4:D4").Value = Array("こ", "さ", "し")
        Range("B5:D5").Value = Array("す", "せ", "そ")
        With Range("A1")
            .Formula = "=B1&C1&D1"
            .AutoFill Destination:=.Resize(5)
        End With

        Stop

        Dim MyRNG As Range, MyRow As Variant

        'FINDメソッドでアプローチ
        With Range("A1:A5")
            Set MyRNG = .Cells.Find _
                (What:="く", LookIn:=xlValues, LookAt:=xlPart)
            If Not MyRNG Is Nothing Then
                MsgBox MyRNG.Row & "行目でみつかりました"
            End If
        End With

        'MATCH関数でアプローチ
        MyRow = Application.Match("*く*", Range("A1:A5"), 0)
        If Not IsError(MyRow) Then
            MsgBox MyRow & "行目でみつかりました"
        End If

        'For～NEXTによるループでアプローチ
        For MyRow = 1 To 5 Step 1
            If Cells(MyRow, "A").Value Like "*く*" Then
                MsgBox MyRow & "行目でみつかりました"
                Exit For
            End If
        Next MyRow
    End Sub
（もこな２） 2018/04/05(木) 22:26

皆様

沢山のご意見ありがとうございます！
本日時間が取れそうなので少しずつですが確認させて頂ければと思います！

今回は、使う方がお年寄りが多いのでなるべく手順を少なくわかりやすくできたらと思いボタンを設置しようと考えています。

まっつわん様

参考URLやコードをありがとうございます！
さっそくチャレンジしてみようと思います！

隠居じーさん様

説明不足ですみません！
管理番号は英字+数字になっています。

またボタンも出したり消したりできるのですね！
勉強になります。

master_key = sh02.Range("C2")
上記の部分が黄色く表示されていました。

もこな２様
ありがとうございます！
時間が取れ次第、調べながらになりますが参考にしてみます！

（悩めるスズキ） 2018/04/06(金) 10:11

 こんにちは　＾＾　下記の様に変更後
お試しを。
Dim master_key As String....
その他、いろいろ、変更して、試してみてください。
では

（隠居じーさん） 2018/04/06(金) 11:44

まっつわん様

教えていただきましたコードを入れて試しましたところ

rngData(vixRow, 2).Resize(, 7).Copy

と

rngData(vixRow, "Q").Value = rngNumber(9, 1).Value

にて、
実行時エラー’13’：
型が一致しません。となってしまいました。

ボタン自体が単体一覧にあることは何か関係しますか？

それと
(vixRow, 2).Resize(, 7)

rngNumber(9, 1)

こちらはどちらを参照するようになっているのでしょうか？
使用するセル等の場所とも違う為、わからず…
申し訳ありませんよろしくお願いします。
（悩めるスズキ） 2018/04/06(金) 12:33

隠居じーさん様
ありがとうございます！
下記に変更したところ無事転記できております！

Sub main()

    Dim master_key As String, lastr As Long, i As Long
    Dim sh02 As Worksheet, sh03 As Worksheet
    Set sh02 = Worksheets("単体一覧")
    Set sh03 = Worksheets("結果")
    master_key = sh02.Range("C2")
    With sh03
        lastr = .Cells(.Rows.Count, 2).End(xlUp).Row
        For i = 1 To lastr
            If .Cells(i, 2) = master_key Then
                .Cells(i, 17) = sh02.Range("C11")
                .Cells(i, 20) = sh02.Range("D11")
            End If
        Next
    End With
End Sub

これは
If .Cells(i, 2) = master_key Then

                .Cells(i, 17) = sh02.Range("C11")
                .Cells(i, 20) = sh02.Range("D11")

こちらでマスターキーをＢ列（2列目）から探して
同じ行のＱ列（17列目）にＣ11を
同じ行のＴ列（20列目）にＤ11を
入れなさい。
という指示になっているのでしょうか？
同様に内容を増やす場合も同じようにこちらを追加すればいいのですね？
.Cells(i, 列が何番目か) = sh02.Range("転記するデータのセル位置")

ありがとうございます！
いろいろ難しく考えすぎてしまっていました。

今回はこちらを使ってほかの物も作ってみようと思います！

まっつわん様の方もお時間があれば再度教えていただけたら嬉しいです！

（悩めるスズキ） 2018/04/06(金) 13:04

 >こちらはどちらを参照するようになっているのでしょうか？ 
1つ目は、
Set rngData = Worksheets("管理表").UsedRange
と代入してますよね？
この代入されているセル範囲の左上が、
(1行目,1列目）という座標で数えます。

vixRow = Application.Match(rngData.Columns(1), rngNumber, 0) は間違ってますね＾＾；↓です。
vixRow = Application.Match(rngNumber,rngData.Columns(1), ,0)
↑で代入されている1列目のセル範囲をMatch関数で検索して、
何番目（＝何行目）にデータがあったか返ってくるので、

元のデータ範囲の(見つかった行番号、2列目）から範囲を7列に広げたセル範囲
rngData(vixRow, 2).Resize(, 7)
となります。

2つ目は
Set rngNumber = Worksheets("単体一覧").Range("C2")
と代入してますので、
C2セルをやはり、（1行目,1列目）見たときに、
9行目の1列目ですからC10セルになります。

こういう相対位置でのセルの特定は使い便利がいいので覚えておくといいと思います。

まぁ、最初にちゃんとセル範囲やデータの例、シートのイメージ等を提示されて
質問者と回答者が同じデータで話が出来るとこういう間違いやすれ違いが少なくなると思います。
想像力を働かせて勝手に作ると、動作確認もしにくいしちょっと間違いが多くなります。
すみませんでした。

（まっつわん） 2018/04/06(金) 13:51

 ＞こちらでマスターキーをＢ列（2列目）から探して 
＞同じ行のＱ列（17列目）にＣ11を 
＞同じ行のＴ列（20列目）にＤ11を 
＞入れなさい。 
＞という指示になっているのでしょうか？ 
＞ 同様に内容を増やす場合も同じようにこちらを追加すればいいのですね？ 
＞.Cells(i, 列が何番目か) = sh02.Range("転記するデータのセル位置") 
概ねそのように、なっています。
今回のように、複数シート間のデーターのやり取りは
各レンジオブジェクトのシート修飾（指定）を間違えると
とんでもない結果を誘発する可能性があります。
くれぐれもご用心下さりませ。
。。。。。上記理由でなんども、ひどい目にあった老人の独り言でした　＾＾
m(__)m

（隠居じーさん） 2018/04/06(金) 15:01

返信が遅くなり申し訳ありません。

まっつわん様

なるほどMatchでスタート地点を検索指定できるのですね！
そこから何個目までと指定できるから、検索結果で移動があってもコードを難しく変更しなくてもいいと…

ありがとうございます！
Matchの方も、いろいろ試して使ってみることにします！

隠居じーさん様
シートの指定を間違えてずっとエラーだったりするので、
確認するようにします。

今回は隠居じーさん様の方法を使って作業していこうと思いますが、
まっつわん様の方法もとても便利なので今後も機会があれば使ってみようと思います！

また、行き詰った際には相談に乗っていただけると嬉しいです！
ありがとうございました！

（悩めるスズキ） 2018/04/09(月) 11:51

コメント返信：

[ 一覧(最新更新順) ]

[[20180405152857]] 『管理番号を検索して同じ行に転記するマクロ』（悩めるスズキ） ページの最後に飛ぶ

[[20180405152857]]　『管理番号を検索して同じ行に転記するマクロ』（悩めるスズキ）　ページの最後に飛ぶ