エクセル2002で、商品を管理しています。
1列目に品番をいれると、2列目に品名が表示するようにし、
新規の品番は品名を入れると、追加登録されるようにVBAを組みました。
今度、このシート"商品"を別ファイル(商品.xls)にしたいと思うのですが、
どうしても、やり方が分かりません。
よろしくお願いします。
Public Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim 品番 As String
Dim 品名 As String
Dim i As Long
With Target
If .Column = 1 Then
品番 = .Text
For i = 1 To 65536
If Sheets("商品").Cells(i, 1) = "" Then
ActiveSheet.Cells(.Row, 2) = ""
Exit For
ElseIf 品番 = Sheets("商品").Cells(i, 1) Then
ActiveSheet.Cells(.Row, 2) = Sheets("商品").Cells(i, 2)
Exit For
End If
Next i
End If
If .Column = 2 Then
品名 = .Text
品番 = ActiveSheet.Cells(.Row, 1)
If 品名 = "" Or 品番 = "" Then
Else
For i = 1 To 65536
If Sheets("商品").Cells(i, 1) = "" Then
Sheets("商品").Cells(i, 1) = 品番
Sheets("商品").Cells(i, 2) = 品名
Exit For
ElseIf 品番 = Sheets("商品").Cells(i, 1) Then
Exit For
End If
Next i
End If
End If
End With
End Sub
No.6ベストアンサー
- 回答日時:
補足に対するお手数をおかけいたしました。
早速サンプルマクロを作ってみました。以下のように操作してみて下さい。1.商品台帳.xlsというブックと商品コードというブックを新規に作る。それぞれのブックのシート1のA1にコード・B1に商品名と入力する。
2.商品台帳.xlsのVBE画面を開き、VBEProjectの下にあるThisWorkbookをダブルクリックしてThisWorkbookのコードエディターを開く。
3.そのコードエディターに下記のコードをコピー・ペーストする。
Private Sub Workbook_Open()
Dim myBook As Workbook
Dim myWbn As String
For Each myBook In Workbooks
myWbn = myBook.Name
If myBook.Name = "商品コード.xls" Then Exit Sub
Next
Workbooks.Open ("C:\My Documents\商品コード.xls")
Workbooks("商品台帳.xls").Activate
End Sub
4.Sheet1のコードエディターを開き、下記のコードをコピー・ペーストをする。
Private Sub Worksheet_Change(ByVal Target As Range)
Dim myRow As Integer
Dim myWsn As Worksheet
Dim myCell As String
Dim myRange As Range
myRow = Target.Row
If Target.Address = Range("A" & myRow).Address _
Or Target.Address = Range("B" & myRow).Address Then
Set myWsn = Workbooks("商品コード.xls").Worksheets(1)
myCell = myWsn.Range("A1").CurrentRegion.SpecialCells(xlCellTypeLastCell).Address
Set myRange = myWsn.Range("A2:" & myCell).Find(Target.Value, lookat:=xlWhole)
Application.EnableEvents = False
If myRange Is Nothing Then
If Target.Address = Range("A" & myRow).Address Then
myWsn.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Value = Target.Value
Else
myWsn.Cells(Rows.Count, 2).End(xlUp).Offset(1, 0).Value = Target.Value
End If
Else
Target.Offset(0, 1).Value = myRange.Offset(0, 1).Value
Target.Offset(0, 1).Columns.EntireColumn.AutoFit
End If
Application.EnableEvents = True
End If
End Sub
あなた様のおやりになりたいことが、できます。
何か不都合なことがありましたら、ご遠慮なくお知らせ下さい。修正サンプルマクロを作りたいと思います。
問題なく稼動しました。
親切に他Bookを開くマクロまで作ってもらって、助かります。
ただ、私の勉強不足でと、VBA記述のレベルが高いせいか、内容理解には時間がかかりそうです。
当面の改造とかを考え、#1の方法と合わせて使わせていただきます。
丁寧な回答ありがとうございました。
No.5
- 回答日時:
#3の者です。
#4のkazuhikoのさんほか詳しく読んでくだっさったようで、まずお礼を申し上げます。他の方ebisさんのご質問・解答の場ですが一言言い訳めいたことを述べさせていただきます。
(1)xlPartのこと
A.縦1列の検索と決まっているのでxlPartでも良いか
と思いました。それにしてはCellsになっていますね 。Range()にしたかったのですが。
B小数例ながらテストをしており、問題なく動きましたの でそのままにしました。
もう少し詳しい、不適当な理由がわかれば教えてください。
(2)Activateの多用の点
私自身気かひけていて、懸念を解答の末尾に書いておりま す。今後勉強して今後は改善したいと思います。
オブジェクト宣言方式?では危ないと過去の経験から推定して、解答の締め きられる時間を気にして、その方式でテストする時間が取れな いと、取りあえず載せました。別のブックの場合も、
WB(1).WS(2).Range(3)で1の部分に
Book名を指定して(単一Bookの場合と同じく)参 照出来ればといつも思いますが、(今回別ブックの参照でてこずり、エラーがでて)うまくいかないケースが多いので諦めました。勉強不足と資料不足で、根本のところが迷いがあり、小生の弱点と心得ております。今後とも宜しく。
No.4
- 回答日時:
#No3のご回答で気になる点がありましたので、生意気ながら意見を述べさせていただきます。
1.Findメソッドで、引数のLook AtにXlpartを指定しておりますが、これでは、私が以前Findメソッドを使ってこの方法で検索をかけた結果、うまく検索ができなかったことがあります。この場合、必ずlook Atには、xlwholeを指定するべきかと思います。
2.処理するときに対象となるブックをいちいちアクティブにしているようですが、変数を2個worksheet型で宣言し、その変数にそれぞれのブックのシート名を代入すれば、もっと簡単になるのではないでしょうか。
以上気がついて点を生意気ながら書かせていただきました。
No.3
- 回答日時:
(1)Booka.xlsのSheet1にA1:B10に
コード商品名
1ノートA4
2定規
4鉛筆
5消しゴム
6挟み
7マーカー
9ボールペン
10糊
12ナイフ
をテストで作りました。
(2)Bookb.xlsを作り保存する。
(3)Bookb.xlsを開き、そのModule1に
Sub test02()
Workbooks.Open ("c:\My Documents\Booka.xls")
End Sub
を作る。そして実行しBooka.xlsを開いておく。
-----
Bookb.xlsを開いているところで
もう一つModule1に
Private Sub Worksheet_Change(ByVal Target As Range)
Dim z As Object
'MsgBox Target
r = Target.Row
c = Target.Column
If c = 1 Then
Windows("booka.xls").Activate
Set z = ActiveWorkbook.Worksheets("Sheet1").Cells.Find(What:=Target, After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False)
' If z Is Nothing Then
' MsgBox "コード無し"
' Exit Sub
' End If
x = z.Offset(0, 1)
Windows("bookb.xls").Activate
ActiveWorkbook.Worksheets("Sheet1").Cells(r, c + 1) = x
Else
End If
End Sub
異なるBookを参照するため行き来するのに、Activateを多用していますが、何か別の方法があるような気がする
が取りあえず載せます。小数例でテスト済み。
またオフコードの入力に対しての備えやDELやその他多用な
入力に対する対処が考えらていません。あとは宜しく。
No.2
- 回答日時:
はじめまして。
1.現在1つのブック(ブックAとする)に2つのシート(商品を管理するシートと品番と品名のみを記入したシート)がある。
2.今度、品番と品名のみを記入したシートを別ブック(ブックBとする)に移動する。
3.商品を管理するシートのA列に品番を入力したとき、入力された品番をブックBの中から探し、見つかった品番に対応する品名をブックAの品番の右隣に自動で表示させる。
4.もしブックAに入力した品番がブックBになかったら、ブックBの品番が書かれている最後のセル番地のすぐ下へ入力させ、その品番に対応する品名をその右隣に入力させる。
あなた様のやられたいことはこのようなことでよろしいのでしょうか。
もし、ちがうのであれば、あなた様のおやりになりたいことを上の要領でお知らせ下さい。
私でよろしければ、サンプルマクロを作ってみたいと思います。
お手数をおかけいたしますが、よろしくお願いいたします。
No.1
- 回答日時:
下の様に修正してみました。
最初の4行を追加。コード内の『Sheets("商品")』を『ws2』に変更しました。
最初の4行で参照・修正するシートを変数ws2に割り当てています。
そのため、コードの意味合いは変更していません。ブック商品は開いてある前提です。
Public → Private にしています。
検索の方法としては、For~Next とは別に、Findを使う方法もあります。
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim wb2 As Workbook 'ブック商品
Dim ws2 As Worksheet 'ブック商品のシート商品
Set wb2 = Workbooks("商品.xls")
Set ws2 = wb2.Worksheets("商品")
Dim 品番 As String
Dim 品名 As String
Dim i As Long
With Target
If .Column = 1 Then
品番 = .Text
For i = 1 To 65536
If ws2.Cells(i, 1) = "" Then
ActiveSheet.Cells(.Row, 2) = ""
Exit For
ElseIf 品番 = ws2.Cells(i, 1) Then
ActiveSheet.Cells(.Row, 2) = ws2.Cells(i, 2)
Exit For
End If
Next i
End If
If .Column = 2 Then
品名 = .Text
品番 = ActiveSheet.Cells(.Row, 1)
If 品名 = "" Or 品番 = "" Then
Else
For i = 1 To 65536
If ws2.Cells(i, 1) = "" Then
ws2.Cells(i, 1) = 品番
ws2.Cells(i, 2) = 品名
Exit For
ElseIf 品番 = ws2.Cells(i, 1) Then
Exit For
End If
Next i
End If
End If
End With
End Sub
やはり他Bookを開く方法しかないようですね。
#6の方法と合わせて使わせていただき、うまく稼動しました。
ありがとうございました。
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
関連するカテゴリからQ&Aを探す
おすすめ情報
- ・漫画をレンタルでお得に読める!
- ・人生のプチ美学を教えてください!!
- ・10秒目をつむったら…
- ・あなたの習慣について教えてください!!
- ・牛、豚、鶏、どれか一つ食べられなくなるとしたら?
- ・【大喜利】【投稿~9/18】 おとぎ話『桃太郎』の知られざるエピソード
- ・街中で見かけて「グッときた人」の思い出
- ・「一気に最後まで読んだ」本、教えて下さい!
- ・幼稚園時代「何組」でしたか?
- ・激凹みから立ち直る方法
- ・1つだけ過去を変えられるとしたら?
- ・【あるあるbot連動企画】あるあるbotに投稿したけど採用されなかったあるある募集
- ・【あるあるbot連動企画】フォロワー20万人のアカウントであなたのあるあるを披露してみませんか?
- ・映画のエンドロール観る派?観ない派?
- ・海外旅行から帰ってきたら、まず何を食べる?
- ・誕生日にもらった意外なもの
- ・天使と悪魔選手権
- ・ちょっと先の未来クイズ第2問
- ・【大喜利】【投稿~9/7】 ロボットの住む世界で流行ってる罰ゲームとは?
- ・推しミネラルウォーターはありますか?
- ・都道府県穴埋めゲーム
- ・この人頭いいなと思ったエピソード
- ・準・究極の選択
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
Excelの警告について
-
VBAでブックを非表示で開いて処...
-
エクセルの関数 ENTERを押...
-
エクセルを共有するとPCによっ...
-
エクセルファイルを開かずにpdf...
-
エクセルで「ディスクがいっぱ...
-
複数ファイルから特定シートの...
-
エクセルで参照しているデータ...
-
エクセルで開いていないbookの...
-
Excel(2010)のフィルターが保...
-
Excelでブックの共有を掛けると...
-
Excel起動時に特定のワークシー...
-
Excel VBA セルと同じ名前のブ...
-
ブックの保護ができないんです...
-
エクセルVBAでブックを相対パス...
-
Excelで複数ブックの同一セルに...
-
エクセルで別ブックをバックグ...
-
エクセルにおける,「ブック」...
-
エクセルファイルをオープンし...
-
Excelファイルをダブルクリック...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
エクセルを共有するとPCによっ...
-
Excelの警告について
-
エクセルの関数 ENTERを押...
-
VBAでブックを非表示で開いて処...
-
エクセルにおける,「ブック」...
-
WorkBooksをオープンさせずにシ...
-
エクセルで参照しているデータ...
-
エクセルで「ディスクがいっぱ...
-
Excelで複数ブックの同一セルに...
-
【マクロ】【VBA】別ブックへの...
-
Excel(2010)のフィルターが保...
-
Excelでブックの共有を掛けると...
-
エクセルで50行ごとに区切った...
-
エクセルでウィンドウの枠固定...
-
同じフォルダへのハイパーリン...
-
ブックのピボットを別ブックに...
-
VBAでブック保護非保護を判定す...
-
【マクロ】for nest について ...
-
エクセルファイルを開かずにpdf...
-
フォルダ内の複数ファイルから...
おすすめ情報