[[20050216230605]]　『在庫管理表の応用』（クライム）　ページの最後に飛ぶ

『在庫管理表の応用』（クライム）

[[20050204215328]]の応用として

http://camaro.ddo.jp/Books/myStockList.xls

 のファイルは大変参考になっております。
 自分としては入荷ボタンは使用せず（すでに入荷一覧は作成済みなので）
 品名の所は「受注番号」とし、これを入力すれば「注文番号」と一致した行の「出荷日」と「出荷数」
に記録させることはできないでしょうか？

 処理日	注文番号　品　名　入荷日	入荷数	出荷日  出荷数 　出荷日  出荷数・・・在庫
 2005/1/1	　a001　　りんご　2005/1/1	　50	2.16    40      2.17　　10　　　　　0
  この様な仕様になります。

 また、シートが月別に分かれている為、１月に入荷したものが２月出荷となる事があります。
 その場合は１月のシートに記録させたいのですが、出来ますでしょうか？
 ちなみに「出荷日」「出荷数」は４つほど欄を設けて頂きたいです。
 どうか宜しくお願い致します。

 なにか丸投げの印象を受けるのですが、そういった印象はあまり好まれませんよ。
どうでしょうか？
とりあえずSheet1のA2にある注文NOをBook内の各シートのA列から検索する
マクロを考えてみました。
後は、ヒットした時にどうするか？だと思うのですが、、どうですか？
とりあえずやってみてわからないところを更に質問されてみてはどうですか？
Sheet1のシートモジュールに貼り付けてA2に何か入力してみてください。。
どうでしょう？
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Wh As Worksheet
Dim MyStr As String, FstAd As String
Dim MyTbl As Range, C As Range
Dim MyFlag As Boolean
If Target.Address(0, 0) <> "A2" Then Exit Sub
If Target.Value = "" Then Exit Sub
MyStr = Target.Value
MsgBox MyStr & "の検索を開始します。。。。"
For Each Wh In Worksheets
    If Wh.Name <> Me.Name Then
        Set MyTbl = Wh.Range("A1", Wh.Range("A65536").End(xlUp))
        Set C = MyTbl.Find(MyStr, , xlValues, xlWhole, xlByColumns, xlNext, True)
        If Not C Is Nothing Then
            MyFlag = True
            FstAd = C.Address
            Do
                Set C = MyTbl.FindNext(C)
                MsgBox MyStr & "は　" & Wh.Name & C.Address(0, 0) & "　にヒットしました。。"
            Loop Until C.Address = FstAd
        End If
    End If
Next
If MyFlag Then
    MsgBox MyStr & "の検索が完了しました。"
Else
    MsgBox MyStr & "は、ありませんでした。"
End If
Set C = Nothing
Set MyTbl = Nothing
End Sub
（SoulMan）

 確かに仰る通り丸投げな感じですね、SoulManさんが考えてもたっらマクロで少しずつ勉強させてもらいます。

 ヒットした後はその隣にあるセル（Ｂ２）の内容を表示させることを考えてみます。
 次にその行を塗りつぶしてＳｈｅｅｔ1のＡ3へ行き「注文ＮＯ．入力」→「検索」という形にしてみたいです。
 ちなみにSoulManさんのマクロは実行できてます。（当たり前ですね）
 ありがとう御座います。(クライム）

 ありゃ、、なにか元気がなくなっちゃいましたねぇ、、
 ちょっときつく聞こえたかな？(;^_^A あせあせ･･･
 クライムさんの言葉をマクロ語に直してみると、、
 >ヒットした後はその隣にあるセル（Ｂ２）の内容を表示させることを
 MsgBox C.Offset(, 1).Value
 >次にその行を塗りつぶして
 C.EntireRow.Interior.ColorIndex = 36
 >Ｓｈｅｅｔ1のＡ3へ行き
 With Worksheets("Sheet1")
    .Select
    .Range("A3").Select
 End With
 こんな感じだと思います。
 わからない時は、先ず「マクロの記録」です。
 私なんかは、、、しょっちゅう記録記録（￣□￣；）！！
 記録すれば大抵のことは出来ると思います。
 何か、しゃしゃり出てきたみたいでごめんなさいね。
 ではでは、頑張ってください。ハッスル♂ハッスル♂です。
（SoulMan）

 はい、頑張ります。
 教えていただいたMsgBox C.Offset(, 1).Valueを 
 Loop Until C.Address = FstAd
 　MsgBox "在庫数は　" & C.Offset(, 1).Value & "　です"
 With Worksheets("Sheet1")
    .Select
    .Range("A3").Select
 End With
 End If
 に変えてみました、記入する場所が解からずエラーの洗礼をうけましたが。。。（汗

 それとＡ3に行かなくてもＡ2に戻ればよかったみたいです。
 .Range("A2").Selectですね。
 マクロは自動記録で列の並び替えくらいしか使えませんでしたが、なんか楽しくなってきました。
 多少凹みましたがご指摘嬉しく思います。これで今月の検収作業が楽になるのならば、、、です。
 ハッスル♂ハッスル♂ 記録記録♪（クライム）

 そうです。ハッスル♂ハッスル♂です。
ちょっと遊んでみました。適当に応用してみてください。
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
'******************************************
'変数の宣言
Dim Wh As Worksheet
Dim MyStr As String, FstAd As String
Dim MyTbl As Range, C As Range
Dim MyFlag As Boolean, MyFlagB As Boolean
'*******************************************
'ターゲットがA2じゃなかったら中止
If Target.Address(0, 0) <> "A2" Then Exit Sub
'Targetが空白だったら中止
If Target.Value = "" Then Exit Sub
'検索値をMyStrに代入
MyStr = Target.Value
'検索開始のお知らせ
MsgBox MyStr & "の検索を開始します。。。。"
'ループの始まり
For Each Wh In Worksheets
    'シートの名前が自分の名前じゃなかったら
    If Wh.Name <> Me.Name Then
        'A列のデータ範囲をMyTblに代入
        Set MyTbl = Wh.Range("A1", Wh.Range("A65536").End(xlUp))
        'Findで検索
        Set C = MyTbl.Find(MyStr, , xlValues, xlWhole, xlByColumns, xlNext, True)
        'ヒットしたら
        If Not C Is Nothing Then
            'MyFlagをTrueにする
            MyFlag = True
            'ループ用に最初のアドレスをFstAdに代入
            FstAd = C.Address
            'Findのループ開始
            Do
                'FindNextで次を検索
                Set C = MyTbl.FindNext(C)
                'ひとつ右隣のセルが空白じゃなかったら
                If Not IsEmpty(C.Offset(, 1).Value) Then
                    'MsgBoxを表示する。
                    If vbYes = MsgBox("在庫数は　" & C.Offset(, 1).Value & _
                        "　です" & Chr(13) & _
                        "着色をして戻りますか？", vbYesNo) Then
                        '戻るを選択したことでMyFlagBをTrueにする
                        MyFlagB = True
                        'ヒットした行に色が付いていなかったら、、
                        If C.EntireRow.Interior.ColorIndex = xlNone Then
                            '色を付ける
                            C.EntireRow.Interior.ColorIndex = 36
                        'ヒットした行に色が付いていたら
                        Else
                            'MsgBoxを表示して色を付けると判断したら
                            If vbYes = MsgBox("既に着色されています" & Chr(13) & _
                                "更に着色しますか？", vbYesNo) Then
                                '色が36番だったら
                                If C.EntireRow.Interior.ColorIndex = 36 Then
                                    '色は4番
                                    C.EntireRow.Interior.ColorIndex = 4
                                '36番以外は36番
                                Else
                                    C.EntireRow.Interior.ColorIndex = 36
                                End If
                                'ヒットした印にMyFlagをTrue
                                MyFlag = True
                            End If
                        End If
                    End If
                    'ヒットした印にMyFlagをTrue
                    MyFlag = True
                Else 'ヒットした右隣が空白だったら
                    If vbYes = MsgBox("在庫数量が未入力です。。" & Chr(13) & _
                            "次を検索しますか？", vbYesNo) Then
                        'MyFlagを初期化
                        MyFlag = False
                    Else '次を検索しない場合はMyLineへジャンプ
                        GoTo MyLine
                    End If
                End If
                'MyFlagがTrueだったら（戻るを選択していたら）MyLineヘジャンプ
                If MyFlagB Then GoTo MyLine
            '最初のアドレスと同じになるまでループ（一周するまでループ）
            Loop Until C.Address = FstAd
        End If
    End If
Next
MyLine:
'MyFlagがTrueだったら
If MyFlag Then
    MsgBox MyStr & "の検索が完了しました。"
Else 'MyFlagがFalseだったら
    MsgBox MyStr & "は、ありませんでした。"
End If
'Sheet1のA2を選択する
With Worksheets("Sheet1")
    .Select
    .Range("A2").Select
End With
'変数の初期化
Set C = Nothing
Set MyTbl = Nothing
End Sub
ちょっと訂正しました。
2005/02/19　1:10
 >マクロは自動記録で列の並び替えくらいしか使えませんでしたが
心配いりません。私も半年前までは清水の舞台から飛び降りてましたから(^_^;)
なんや自分でもようわからへんようになってたぁ(^_^;)(^_^;)
（SoulMan）

 清水の舞台から飛び降りると危ないですよ～。ちなみに江戸時代には２３４人が飛び降りたそうです。^^;
 解説まで入れていただいたこのコードは大切に保管します。ネックになっていた問題も１つ解決しそうです。有難う御座いました。（クライム）

 >江戸時代には２３４人・・・
 そうなんですかぁ、、勉強になりました。
今日別件ですが、検索のマクロがあったので、よかったら参考にしてみてください。
[[20050219121221]]『検索用のマクロについて』（マクロ勉強中） 
ではでは、、
（SoulMan）

 拝見させて戴きました。使用してみたら「インデックスが有効範囲外です」って言われました。（汗汗；）
 範囲指定はRange(Ａ1：Ｂ1）を追加すればよろしいのですかね？
 それとF1キーでヘルプが表示されるのを発見しました。

 With Worksheets("住所録")
    MOJI = InputBox("検索文字入力")'これは勝手に表示される
    If MOJI <> "" Then
        Set C = .Cells.Find(MOJI, , xlValues, xlWhole, xlByRows, xlNext, True)
        If Not C Is Nothing Then 'ここまでは形で覚える。xlValues, xlWhole, xlByRows, xlNext達の意味は解かりません。
                Set C = .Cells.FindNext(C)

                Loop　'ここまで繰り返し？

 要約ですが考えてみました。（クライム）

 こんばんは！頑張っていらしゃる様ですね^^
エラーもなれてくるとすぐにわかる様になります。
 >インデックスが有効範囲外です
 これは、
With Worksheets("住所録")
「住所録」という名前のシートがないからです。
だから、
「インデックスが有効範囲外」です。とでるのです。
住所録というシートをつくるかまたは、
これを↓
With Worksheets("住所録")
↓これに
With Worksheets("Sheet1")
するかです。
どうでしょうか？
追伸！
 >xlValues, xlWhole, xlByRows, xlNext達の意味は解かりません。
これは、
 >それとF1キーでヘルプが表示されるのを発見しました。
これを活用されればすぐにわかりますが、
結局Findは編集→検索のことなのです。
記録すれば簡単に↓の様なコードを入手出来ます。
Findで大切なことは引き数を省略しないことです。
よく引き数を省略している人がいますが、省略しないことが基本です。
後は、シートの上で実際にやってみて動きを確認されてから記録するなり
ヘルプをみるなりなさればいいと思います。
Sub Macro2()
'
' Macro2 Macro
' マクロ記録日 : 2005/2/21  ユーザー名 : SoulMan
'

 Selection.Find(What:="Ok", After:=ActiveCell, LookIn:=xlValues, LookAt _
    :=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
    True).Activate
Selection.FindNext(After:=ActiveCell).Activate
End Sub
（SoulMan）

 早い回答ありがとうございます。確か御前様ぎりぎりだったと思いましたが。。。
 ＞記録すれば簡単にコードを入手出来ます。
 Findを自動記録で、ってことですか？自動記録は１、２回の動きをして確認してます。
 これだと簡単なコードは発見できますが、Findとなると…、うーん。。。
 一度Vlookupをする所を記録で見てみようと思います。
 上記のコードをそのまま使用すると「Withなんとかが、なんとかです」って出ました（ごめんさい、記憶力が低下してます）(T_T)

 P.S SoulManさんはいつお休みになられるのでしょうか？他の質問への回答時刻が夜中になってましたので。。。
 (クライム）

 ありゃ？えらく古いレスがあがってきましたねぇ？？
 これは放置しているから答えないということかな？？
 >Withなんとかが、なんとかです」って出ました
 これはその時どんなつもりで書き込みしたかは覚えていませんが、
 記録したままですから、セルに適当に「Ok」という文字を入力して
 その範囲を選択してから実行すれば動きますよね？
 >SoulManさんはいつお休みになられるのでしょうか？
 気まぐれですからねぇ。。神出鬼没です。とは言っても適当に寝てますからね(^^;
 ご心配ありがとうございます。何か放置していたようで申し訳ありませんでしたね。
 ではでは、、
（SoulMan）

 在庫管理関連のトピックを、いくつか上げさせて頂きました。(_ _)
  (INA)

コメント返信：

[ 一覧(最新更新順) ]

[[20050216230605]] 『在庫管理表の応用』（クライム） ページの最後に飛ぶ

[[20050216230605]]　『在庫管理表の応用』（クライム）　ページの最後に飛ぶ