ExcelVBAをもちいて、在庫の確認をしたいのですが、できるのでしょうか。

具体的には、在庫一覧のシートと注文一覧のシートをつくり、その二つのシートから一致した商品をさらに別のシートに取り出すという作業がしたいです。
一個の注文が着たときは、なんとか対応できるのですが、まとまった注文が来たときのいい対応方法を探しています。

よろしくお願いします。

このQ&Aに関連する最新のQ&A

A 回答 (4件)

Public Enum SearchPatternEnum


 完全一致 = 0
 先頭一致 = 1
 後方一致 = 2
 部分一致 = 3
End Enum

Public Function SearchData(検索値 As Variant, 検索範囲 As Range, Optional 列番号 As Long = 1, Optional 検索方法 As SearchPatternEnum, Optional 出力セル範囲 As Range = Nothing) As Variant
 Dim RNG As Range
 Dim SearchRng As Range
 Dim SrchStr As String
 Dim MaxRow As Long
 Dim OutputRNG As Range
 Dim MaxOutputPos As Long
 Dim OutputPos As Long

 If TypeOf 検索値 Is Range Then
  SrchStr = 検索値.Value
 Else
  SrchStr = CStr(検索値)
 End If

 Select Case 検索方法
  Case SearchPatternEnum.完全一致
   '処理を行わない
  Case SearchPatternEnum.先頭一致
   SrchStr = SrchStr & "*"
  Case SearchPatternEnum.後方一致
   SrchStr = "*" & SrchStr
  Case SearchPatternEnum.部分一致
   SrchStr = "*" & SrchStr & "*"
 End Select

 If 出力セル範囲 Is Nothing Then
  SearchData = CVErr(1)
 Else
  出力セル範囲.Clear
  MaxOutputPos = 出力セル範囲.Cells.Count
  OutputPos = 1
 End If

 For Each RNG In 検索範囲.Cells
  If RNG.Value Like SrchStr Then
   If MaxOutputPos = 0 Then
    SearchData = Cells(RNG.Row, RNG.Column + (列番号 - 1))
    Exit For
   Else
    出力セル範囲.Cells(OutputPos) = Cells(RNG.Row, RNG.Column + (列番号 - 1))
    OutputPos = OutputPos + 1
    If OutputPos > MaxOutputPos Then
     Exit For
    End If
   End If
  End If
  If RNG.Row > RNG.Worksheet.UsedRange.Rows.Count Then
   Exit For
  End If
 Next RNG
End Function
    • good
    • 0
この回答へのお礼

非常に丁寧な解答ありがとうございました。
これを見た瞬間、正直いって驚かされました。

ARCさんの回答を利用させていただきます。
あっという間に解決できそうです。

ほんとうにありがとうございます。

お礼日時:2001/02/07 16:20

可能か不可能かってことでしたら、可能です。



部分一致を判定するためには、 Like 演算子を使います。

今回のご質問にはちょっと興味を惹かれましたので、暇つぶしに作ってみました。
参考にするなり、適当に改造するなりしてみてください。
解説が必要でしたら、補足をお願いします。

使い方
SearchDate(検索値, 検索範囲, 列番号, 検索方法, 出力セル範囲)
検索値: 略
検索範囲: 略

列番号: どの列を返すか。 1を指定すると、検索されたセルの内容を返す 2なら検索されたセルの右隣のセル内容、3なら更にその右隣のセル…

検索方法: 以下の値を数値で指定(完全一致=0, 先頭一致=1, 後方一致=2, 部分一致=3)

出力セル範囲: 検索した結果を書き出すセルの範囲 例: F1:F10



使用例:(A列に商品名,B列に価格が入力されている場合)

・適当なセルに
=SearchData("あ",A:B,2,3)
と記述(最初に検索された"あ"を含む商品の価格を表示する。)

・モジュールに
call SearchData("あ",Range("A:B"),1,部分一致 ,Range("F1:F100"))
call SearchData("あ",Range("A:B"),2,部分一致 ,Range("G1:G100"))
と記述(F1:F100の範囲に、"あ"を含む商品の一覧を出力,G1:G100に、その商品の価格を出力)
    • good
    • 0

VBAがお解りになるなら、そんなに難しくはありません。

定期的に行う必要があるようでしたら、VBAでプログラム化したほうがべんりですよね。

私は、同じようなことをVBAでやっています。
在庫表と注文表は別のブックにして、同時に両ブックを開き、照合もしています。
VBAなら、コマンドボタンにプログラムを貼り付けてやれば簡単です。
    • good
    • 0

マクロを使わなくても、関数だけで可能みたいですね。



・Sheet2のA列に商品コード、B列に商品名、C列に在庫が入力されているものとします。

・Sheet1のA列に商品コードを入れると、B列、C列に該当する商品の名称、在庫を表示するものとします。

1:Sheet1のB2のセルに
=VLOOKUP($A$2,Sheet2!$A:$C,2)
と入力

2:Sheet1のC2のセルに
=VLOOKUP($A$2,Sheet2!$A:$C,3)
と入力

3:B2,C2のセルを下のほうまでコピー

以上の操作でOKな筈です。

不明点とかありましたら、補足してください。

この回答への補足

これで、商品名の部分検索とかはできるのでしょうか?
商品名のはじめの5文字で検索とか含まれるものとか
ということです。

というのも商品コードがあるとなんとかなるのですが、
注文と在庫の一覧には商品コードがないんです。
(ちなみに当方、古書店です。書籍コードがない場合、
お客様が知らない場合があります。)

おそらく答えるのに、えらい長い行数がいると
思いますので、できる可能性があるかどうか教えて
いただければ、いいです。
できそうなら、自分でがんばってみたいです。

お手数かけまして申し訳ないです。

補足日時:2001/02/03 20:03
    • good
    • 0

このQ&Aに関連する人気のQ&A

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aと関連する良く見られている質問

Qエクセルで、顧客別の注文商品リストかから、自動的に別シートの商品別の注文顧客リストを作成したい 具

エクセルで、顧客別の注文商品リストかから、自動的に別シートの商品別の注文顧客リストを作成したい

具体的には、
【シート1】
山田 キャベツ リンゴ
鈴木 ネギ 白菜
石井 リンゴ

↓ 商品名を入力したら、

【シート2】
白菜 鈴木
リンゴ 山田 石井
キャベツ 山田
人参
ネギ 鈴木

このように各商品の列に注文者名が自動記載されるようにしたい。

こんなことが可能でしょうか?
よろしくお願いします。

Aベストアンサー

す、すみません m(_ _)m
=IF(COUNTIF($B$1:$C$3,$E1)<COLUMN(A1),"",INDEX($A$1:$A$3,SMALL(IF($E1=$B$1:$C$3,ROW($A$1:$A$3)),COLUMN(A1))))
[Ctrl]+[Shft] +[Enter] で確定、配列数式。{ }で挟まれる
です。ROWとCOLUMNを間違ってました

Qエクセルのシート名を、シート1に作成した新旧一覧表に対応させる形で、複数シート一括で変更するには?

エクセルのシート名の変更について教えてください。

シート1のA列に、現在のブックのシート名が、
シート1のB列には、変更したいシート名が
対応するように入力されています。
シート数は50~200程度で、つど変わります。


    A列    B列
1行目:りんご   赤色 
2行目:ばなな   黄色
3行目:メロン   緑色
    ・     ・
    ・     ・
    ・     ・

※この場合、「りんご」は「赤色」に、「ばなな」は「黄色」に、
「メロン」は「緑色」に、それぞれシート名を変換したい。

今は、手作業でひとつずつシート名を変換しており、
かなりの手間で困っています。
一覧表を作成するまでは手作業でいいのですが、
何とかして、シート名の変更を、この一覧表を参照して
できないでしょうか?
過去の質問をいろいろと見たのですが、
該当するものが見つけられず、VBAも初心者のため、
途方にくれています。
ぜひともご教授ください。

Aベストアンサー

マクロサンプルです。マクロは標準モジュールシートに貼り付けてください。変換表のシート名は4行目を修正のこと。

Sub Macro1()
Dim sh As Worksheet
Dim res
Const trg As String = "Sheet1" 'シート1のシート名に変更
For Each sh In Worksheets
  Set res = Worksheets(trg).Range("A:A").Find( _
    what:=sh.Name, LookIn:=xlValues, Lookat:=xlWhole)
  If Not res Is Nothing Then
    sh.Name = res.Offset(0, 1).Value
  End If
Next sh
End Sub

QExcel一覧シートから複数シートの作成

EXCEL等で、情報一覧シートから、複数の個別情報シートを作りたいです。

例えば、情報一覧シートに10人の名前・住所の情報があるとすれば、
個々の名前・住所が指定のセルに記入されたシート10枚を、一覧の順に作る、という感じです。

下記リンクと逆のことを行えばいいと思いますが、方法がわかりません・・・
http://oshiete1.goo.ne.jp/qa3550265.html?ans_count_asc=20

情報一覧シートはCSVなので、excel以外にaccessなどでも可と思います。
マクロなどはわからないのですが、
出来る場合の方法、マクロの場合の簡単な解説などを
ぜひ教えてください。よろしくお願いします。

Aベストアンサー

こんばんは、ちょっと希望と違いますが、こちらのほうが便利そうですので、紹介します。
データのシート
氏名  住所 電話番号・・・・
氏名の列に、定義で名前をつける
表示用のシートを1枚準備
 適当なセルに、入力規則を設定して、氏名を選択して表示させる
 別のセルにはVLOOKUP関数で住所など表示させる

マクロの記録
 表示用のシート選択、コピィ
 新しいシートの挿入
 貼り付け、形式を選択して貼り付け、値にチェックでOK
 表示用のシートに戻り
マクロの記録の終了

ただ、むやみにシートを増やす方法はお勧めしません。
データのシートと表示のシートの2枚で済むということはないでしょうか。

 

QExcelの各シートの一覧シートの作り方について

よろしくお願いします
仕事で顧客(例A様、B様、C様)の各週間予定表を一つのシートで作成してお配りしているのですが、それを一覧できるシートを自動作成したいと思っています
これまでは各シートを確認しながらの間違いやすい、手間のかかる作り方をしていましたがなんとか効率化できればと思っています
曜日毎で時間が重なる場合は2、3名のお名前が載せれるように、そして一覧では30分区切りにしていますが、各顧客週間予定表では15分刻みにしているので繰り上げ(9時15分なら9時30分へ)して一覧に載せたいと思っています
また、このような一覧の作り方だと難しい場合は違う様式で一覧シートを作成になってもかまいません
Excelの本など読みましたが参考になるのはなく、なんとかお知恵を拝借できますでしょうか

Aベストアンサー

一覧、顧客予定表のレイアウトが小っちゃくて、よく分からなかったので、勝手に想像してVBAを書いてみました。こちらの想定は下図の通りです。差異がある場合は、適宜、コードを修正して下さい。

各時間は、シリアル値で入力してください。もし、顧客予定表の時間を「9:00~」と表示したい場合は、書式設定で「h:mm"~"」としてください。
顧客予定表の時間に、一覧の時間を超えるような値(例えば、23:00とか)を入力した場合、一覧上の一番遅い時間に転記されます(一覧に存在する直近の時間に転記するようにしています)
一応、エラー処理は入れていますが、かなり雑です。必要に応じて追加してください。

Sub sample()
Dim ws As Worksheet
With Sheets("一覧")
Range(.Cells(2, 2), .Cells(Rows.Count, Columns.Count)).Clear
End With
For Each ws In Worksheets
If ws.Name <> "一覧" Then Call subTenki(ws)
Next
End Sub

Sub subTenki(ws As Worksheet)
Dim rng As Range
Dim c As Long
Dim r As Long
On Error GoTo ErrorHandler
With Sheets("一覧")
For Each rng In ws.Range("A5:F5")
If rng.Value <> "" Then
c = WorksheetFunction.Match(rng, .Rows("1:1"), 1)
r = WorksheetFunction.Match(rng.Offset(-1), .Columns("A:A"), 0)
If .Cells(r, c) = "" Then
.Cells(r, c) = ws.Range("A1")
Else
.Cells(r, c) = Cells(r, c) & _
vbLf & ws.Range("A1")
End If
End If
Next
End With
Exit Sub
ErrorHandler:
MsgBox ws.Range("A1") & "(" & ws.Name & ") に不正な入力があります。" _
& vbLf & "このシートの転記を中断しました。"
End Sub

一覧、顧客予定表のレイアウトが小っちゃくて、よく分からなかったので、勝手に想像してVBAを書いてみました。こちらの想定は下図の通りです。差異がある場合は、適宜、コードを修正して下さい。

各時間は、シリアル値で入力してください。もし、顧客予定表の時間を「9:00~」と表示したい場合は、書式設定で「h:mm"~"」としてください。
顧客予定表の時間に、一覧の時間を超えるような値(例えば、23:00とか)を入力した場合、一覧上の一番遅い時間に転記されます(一覧に存在する直近の時間に転記するように...続きを読む

QマクロでVLOOKUPを使用した複数シートのデータを一覧シートへ

VLOOKUP関数を使用してシートを跨いでデータを一覧へもってくることができないようなので、
マクロを使用して以下のような作業をしたいです。


【Sheet1】:データベース(1)
   A列  B列
1行 0001  あ
2行 0003  う

【Sheet2】:データベース(2)
   A列  B列
1行 0002  い
2行 0004  え
3行 0005  お

というデータから

【Sheet3】:一覧
   A列  B列
1行 0001  あ
2行 0002  い
3行 0003  う
4行 0004  え
5行 0005  お

を作成したい。

データベース(1)(2)は各々で全て手入力をし、
一覧のA列は予め入力しておき、B列の情報だけを一覧シートにもってくるという内容です。
(実際はセル数もシート数ももっと多いです)
Application.WorksheetFunction.VLookup()を使うのかな?
とは過去の質問から、なんとなく想像はつくのですが
素人なもので、例文を見てもよくわかりません・・・。

ご教授いただけると大変助かります。
よろしくお願い致します。

VLOOKUP関数を使用してシートを跨いでデータを一覧へもってくることができないようなので、
マクロを使用して以下のような作業をしたいです。


【Sheet1】:データベース(1)
   A列  B列
1行 0001  あ
2行 0003  う

【Sheet2】:データベース(2)
   A列  B列
1行 0002  い
2行 0004  え
3行 0005  お

というデータから

【Sheet3】:一覧
   A列  B列
1行 0001  あ
2行 0002  い
3行 0003  う
4行 0004  え
5行 0005  お

を作成したい...続きを読む

Aベストアンサー

簡単にこんな感じじゃダメなんですか?

Sub DataMerge()

  Dim SH1 As Worksheet, SH2 As Worksheet, SH3 As Worksheet

  Set SH1 = Sheets("Sheet1")
  Set SH2 = Sheets("Sheet2")
  Set SH3 = Sheets("Sheet3")
  
  'Sheet3初期化
  SH3.Cells.Clear
    
  'Sheet1の最終行
  lngR = SH1.Range("A65536").End(xlUp).Row
  'Sheet1のデータをSheet3へコピー
  SH1.Range("A1:B" & lngR).Copy Destination:=SH3.Range("A1")
  'Sheet2の最終行
  lngR = SH2.Range("A65536").End(xlUp).Row
  'Sheet2のデータをSheet3へコピー
  SH2.Range("A1:B" & lngR).Copy _
    Destination:=SH3.Range("A65536").End(xlUp).Offset(1)
  
  'Sheet3の最終行
  lngR = SH3.Range("A65536").End(xlUp).Row
  '並べ替え
  SH3.Range("A1:B" & lngR).Sort Key1:=Range("A1"), Order1:=xlAscending
  
  Set SH1 = Nothing
  Set SH2 = Nothing
  Set SH3 = Nothing
  
End Sub

簡単にこんな感じじゃダメなんですか?

Sub DataMerge()

  Dim SH1 As Worksheet, SH2 As Worksheet, SH3 As Worksheet

  Set SH1 = Sheets("Sheet1")
  Set SH2 = Sheets("Sheet2")
  Set SH3 = Sheets("Sheet3")
  
  'Sheet3初期化
  SH3.Cells.Clear
    
  'Sheet1の最終行
  lngR = SH1.Range("A65536").End(xlUp).Row
  'Sheet1のデータをSheet3へコピー
  SH1.Range("A1:B" & lngR).Copy Destination:=SH3.Range("A1")
  'Sheet2の最終行
  lngR = SH...続きを読む


人気Q&Aランキング

おすすめ情報