エクセル2000で教えて下さい。

質問

いつも　お世話になっています。
例でお話させていただきます。
マクロで記述したいのですが、
SHEET1のセルA1に秋葉原A2に上野A3に秋葉と記入されています。
SHEET2のB1に秋と入力させています。
SHEET3のA1・・・に項目が一致した秋葉原　A2に秋葉と転送を
行いたいのですが、関数がわかりません。
よろしくお願いします。

回答No.1

nishi6 · ベストアンサー

書き出す条件がはっきりしませんが、今は、Sheet2のB1セルとSheet1のA列の文字の先頭文字が一致すればSheet3に書き出しています。

質問の例でいえば、Sheet2のB1に『秋』と入力して、下のマクロを実行します。

Sheet2のB1セルの文字が、Sheet1のA列の文字に含まれていれば書き出すなら、
　If InStr(ws1.Cells(schRow, 1), ws2.Cells(1, 2)) > 0 Then
と変更します。

ここから。（標準モジュールに貼り付けます）
↓
Sub Kensaku()
　　Dim ws1 As Worksheet 'Sheet1
　　Dim ws2 As Worksheet 'Sheet2
　　Dim ws3 As Worksheet 'Sheet3
　　　　Set ws1 = Worksheets("Sheet1")
　　　　Set ws2 = Worksheets("Sheet2")
　　　　Set ws3 = Worksheets("Sheet3")
　　Dim schRow As Long '検索する行
　　Dim wrtRow As Long '書き出す行

　　schRow = 1
　　ws3.Columns(1).ClearContents 'シート3のA列をクリア

　　'シート1のA列が入力されているなら調べる
　　While ws1.Cells(schRow, 1) <> ""
　　　　If InStr(ws1.Cells(schRow, 1), ws2.Cells(1, 2)) = 1 Then
　　　　　　'シート2のB1がシート1のA列の先頭文字と一致ならシート3に書く
　　　　　　wrtRow = wrtRow + 1
　　　　　　ws3.Cells(wrtRow, 1) = ws1.Cells(schRow, 1)
　　　　End If

　　　　'シート1の次の行
　　　　schRow = schRow + 1
　　Wend
End Sub

お礼

ありがとうございました。

回答No.2

imogasi

VBAでも＃１のnishi6さんのものと、感じが違うのですが
上げて見ます。VBAも（１）繰り返しロジック中心（２）
エクセルの操作（メソッド）を採り入れたもの（本件）
（３）関数を中心に使ったものなどが考えられます。
(テストデータ）
Sheet1のA1～A11
秋葉原
上野
御徒町
秋葉
日暮里
池袋
王子
秋津
大宮
秋田
山秋
Sheet2
秋（B1セル)
Sheet3のA1～A5
秋葉
秋津
秋田
山秋
秋葉原
（VBA)
Sub test02()
Dim a As Range
b = Sheet2.Cells(1, 2)
j = 1
Sheet1.Activate
Set a = Sheet1.Range("A1:A11").Find(What:=b, LookIn:=xlFormulas, LookAt _ '*
　　 :=xlPart, SearchOrder:=xlByColumns, MatchCase:= _
False)
a.Activate
l = a.Address
' MsgBox a
p01:
Sheet3.Cells(j, 1) = a 'ActiveCell
j = j + 1
Set a = Sheet1.Cells.FindNext(After:=ActiveCell)
If l = a.Address Then GoTo p02
' MsgBox a
a.Activate
GoTo p01
p02:
End Sub
(注）Find(・・・・)の（）内は、OKWEBで強制改行されるでしょうが、１行に続けてください。
＊の行は、その上の行の右端に続けてください。