【最大10000ポイント】当たる!!質問投稿キャンペーン!

ご質問です。
複数キー中1つ以上のキーが部分一致する行(複数列で構成)を選択し、フラグを入れたいです。
下記の例で言いますと、Sheet1の1行に、Sheet2の列中の1つ以上が部分一致する場合、1と記入したいと思います。
(Sheet1)
 A     B      C      D       E           B          C
1)                     (条件1チェック) (条件2チェック)(条件3チェック)
2) 犬あ  猿い   う鳥   え魚       1         1
3) 豚い  熊え   ね兎   蛇ら                            1
4) 猫た  龍さ   魚み   羊り       1                     1
・・・・500件続くアンケートです。
(Sheet2)
 A       B       C  
1) (条件1)  (条件2) (条件3)
2) 犬     猿     豚
3) 猫     馬     羊
4) 狐     牛     熊
FindとLoopで作ってみましたが、上記で言うところのSheet1の先頭行しか検索してくれませんでした。どなたか、FindとLoop(またはFor)で教えてくださいますでしょうか。
↓できなかった私の作成物
With WS(2).Range("a2:c5")
Set c = .Find(What:=myKey, LookIn:=xlValues, LookAt:=xlPart, _
SearchOrder:=xlByColumns, MatchByte:=False)
If Not c Is Nothing Then
fAddress = c.Address
Do
WS(2).Cells(m,1).vakue=1
Set c = .FindNext(c)
If c.Address = fAddress Then Exit Do
Loop
3日悩んで、大変困っております。よろしくお願いします。(OS:WindosXP、Office2003)

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

A 回答 (4件)

こんなカンジですかね。



sub macro1()
 dim h as range
 dim c as range
 dim s as string
 worksheets("Sheet1").range("E:G").clearcontents

’シート1の中に…
 with worksheets("Sheet1").range("A:D")
’条件を一つずつ調査する
 for each h in worksheets("Sheet2").range("A2:C5")
  if h <> "" then
   set c = .find(what:=h, lookin:=xlvalues, lookat:=xlpart)
   if not c is nothing then
    s = c.address
    do
    ’あればフラグを立てる
     worksheets("Sheet1").cells(c.row, 4 + h.column) = 1
     set c = .findnext(c)
    loop until c.address = s
   end if
  end if
 next
 end with
end sub




#ちなみに
E2に
=IF(OR((Sheet2!A$1:A$5<>"")*ISNUMBER(FIND(Sheet2!A$1:A$5&"",$A2:$D2))),1,"")
と記入してコントロールキーとシフトキーを押しながらEnterで入力し,右にコピー,下にコピー。
    • good
    • 0
この回答へのお礼

>worksheets("Sheet1").cells(c.row, 4 + h.column) = 1 の発想がなかったので出来なかったとわかりました。また、処理コメントも書いていただいてよくわかりました。すぐのお返事ありがとうございます。大変助かりました。

お礼日時:2011/07/01 12:47

>Sheet1の先頭行しか検索してくれませんでした


Findメソッドだけでなく、FINDNEXT[が必要なだけでは。
Googleで「エクセル VBA 検索」で照会してコードをさがして、真似したら。
初心者にはFind、Findねxtは使うのが難しいと思う。
しかし、まあそれは本件で使っているのですね。
ーー
質問にロジックの説明が無く、ありふれたケースではないので、判るのに時間がかかる。
実例だけでなく、しっかり文章でも説明のこと。
ーー
ロジックは、検索対象としては行単位で考えるらしい。本件ではその範囲はSheet1の各行1-3列
検索語としては第1回目が、条件1がSheet2の犬。次いで猫の検索をまわさないとならないようだが、質問のコードではそれが見えないが。
犬と猫の検索をVBAで1度でやる方法は無いと思う。IF分ならORを使って、やれそうだがSheet2のA列のように多いとそれも使えない。
だからこれらのループをFor Nextの総なめ法でテスト的にコードを作り、結果が正しくなったら、それからFind法に置き換えたら。
Sheet1の「ある1行」の列の判別ループ
Sheet2の条件の各列の各行のループ
条件が条件1、条件2・・と複数あるループ。
を見据える。
ーー
).vakue=1 はValue
でしょう。
    • good
    • 0
この回答へのお礼

ロジックを私の代わりにご説明していただきありがとうございます。(詳しく書くよう心がけます。)一時的なテキストを生成して検索している他の方のやり方を理解するのに役立ちました。感謝いたします。誤記(vakueではなくvalueです)も訂正いたします。

お礼日時:2011/07/01 12:55

こんな方法も……



Sub sample()
Dim i, j, k
Dim sTraget As String
Dim sTraget2 As String
Dim sWord As String

With Worksheets("Sheet1")
  For i = 2 To .Range("A2").End(xlDown).Row
    sTarget = .Cells(i, 1) & .Cells(i, 2) & .Cells(i, 3) & .Cells(i, 4) 'A~D列の文字列を結合
    For j = 1 To 3 '条件
      sTarget2 = sTarget
      For k = 1 To 3
        sWord = Worksheets("Sheet2").Cells(k + 1, j).Text
        '条件と一致する文字列を削除
        sTarget2 = Replace(sTarget2, sWord, "")
      Next k
      'もとの結合文字列より短ければ一致あり
      If Len(sTarget) > Len(sTarget2) Then .Cells(i, j + 4) = 1
    Next j
  Next i
End With
End Sub
    • good
    • 0
この回答へのお礼

>sTarget = .Cells(i, 1) & .Cells(i, 2) & .Cells(i, 3) & .Cells(i, 4)
'A~D列の文字列を結合        
>'条件と一致する文字列を削除
>sTarget2 = Replace(sTarget2, sWord, "")

と私の中では新境地のコードです。今後のコード学習につながるので助かります。コードもきちんと動きました。ありがとうございます。

お礼日時:2011/07/01 13:01

もう検索での回答が出ていますので配列に入れて比較する方法の一例です。



Sub test01()
  Dim myW, myX, myY
  Dim i As Long, j As Long, l As Long, n As Long
  Dim ws(1 To 2) As Worksheet
  Set ws(1) = Sheets("Sheet1")
  Set ws(2) = Sheets("Sheet2")
  With ws(1)
   myW = .Range(.Range("A2:D2"), .Range("A2:D2").End(xlDown)).Value
  End With
  With ws(2)
   myX = .Range(.Range("A2:C2"), .Range("A2:C2").End(xlDown)).Value
  End With
  ReDim myY(1 To UBound(myW, 1), 1 To 3)
  For i = 1 To 4
    For j = 1 To UBound(myW, 1)
      For l = 1 To 3
        For n = 1 To UBound(myX, 1)
          If InStr(myW(j, i), myX(n, l)) > 0 Then
            myY(j, l) = 1
            Exit For
          End If
        Next n
      Next l
    Next j
  Next i
  ws(1).Range("E2").Resize(UBound(myW, 1), 3).Value = myY
End Sub
    • good
    • 0
この回答へのお礼

>ReDim myY(1 To UBound(myW, 1), 1 To 3)
>If InStr(myW(j, i), myX(n, l)) > 0 Then
という私には初めてのやり方なので勉強になります。コードもすぐ動いて助かりました。学習素材に最適なご回答ありがとうございます。

お礼日時:2011/07/01 12:58

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

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

このQ&Aを見た人はこんなQ&Aも見ています

このQ&Aを見た人が検索しているワード

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

QエクセルVBAで複数の条件を満たす検索方法

エクセルのVBAを使ってデータ検索を行うプログラムを作っています

"Sheet2"は下記のように、A列に生年月日、B列に住所、C列に電話番号、D列にメールアドレスが入力されています

       【Sheet2】
  生年月日  住所    電話番号  メールアドレス
    A      B       C        D
1 1999/9/10 東京都○○ 11-111-1111 aa@goo.co.jp
2 2003/2/26 大阪府○○ 22-222-2222 bb@goo.co.jp
3 1985/6/22 福岡県○○ 33-333-3333 cc@goo.co.jp
4 1995/4/11 愛知県○○ 44-444-4444 dd@goo.co.jp


"Sheet1"のA1に生年月日、A2に住所、A3に電話番号を入力し、"Sheet2"のデータと照合して、3つの値が合致した行のD列のメールアドレスを"Sheet1"のB1に返したいと思います

上記の表だと、"Sheet1"のA1に1985/6/22、A2に福岡県○○、A3に33-333-3333と入力されている場合、B1にcc@goo.co.jpの値を返すようにしたいのです。

findを使って生年月日、住所、電話番号を検索し、行番号を取得して、3つの行番号が同じならその行番号のD列の値を返すというような方法で考えていたのですが、エラーが回避できずに困っています。
生年月日が同じ人がいたり、夫婦や親子などは住所と電話番号が同じといった場合があり、上手く検索できません。 

エラー回避の方法、もしくは他のやり方でも構いませんので
どなたかご教授願えないでしょうか?
よろしくお願いします。

エクセルのVBAを使ってデータ検索を行うプログラムを作っています

"Sheet2"は下記のように、A列に生年月日、B列に住所、C列に電話番号、D列にメールアドレスが入力されています

       【Sheet2】
  生年月日  住所    電話番号  メールアドレス
    A      B       C        D
1 1999/9/10 東京都○○ 11-111-1111 aa@goo.co.jp
2 2003/2/26 大阪府○○ 22-222-2222 bb@goo.co.jp
3 1985/6/22 福岡県○○ 33-333-3333 cc@goo.co.jp
4 1995/4/11 ...続きを読む

Aベストアンサー

ANo.2です。
すみません。ミスがありました。
Sub test()

Dim sh1 As Object, sh2 As Object
Dim d1 As String, d2 As String, r As Long

Set sh1 = Sheets("Sheet1")
Set sh2 = Sheets("Sheet2")

r = 1
d1 = sh1.Cells(1, 1) & sh1.Cells(2, 1) & sh1.Cells(3, 1)
d2 = sh2.Cells(r, 1) & sh2.Cells(r, 2) & sh2.Cells(r, 3)
Do While d2 <> ""
If d1 = d2 Then
sh1.Cells(1, 2) = sh2.Cells(r, 4)
Exit Do
End If
r = r + 1
d2 = sh2.Cells(r, 1) & sh2.Cells(r, 2) & sh2.Cells(r, 3)
Loop

End Sub

ANo.2です。
すみません。ミスがありました。
Sub test()

Dim sh1 As Object, sh2 As Object
Dim d1 As String, d2 As String, r As Long

Set sh1 = Sheets("Sheet1")
Set sh2 = Sheets("Sheet2")

r = 1
d1 = sh1.Cells(1, 1) & sh1.Cells(2, 1) & sh1.Cells(3, 1)
d2 = sh2.Cells(r, 1) & sh2.Cells(r, 2) & sh2.Cells(r, 3)
Do While d2 <> ""
If d1 = d2 Then
sh1.Cells(1, 2) = sh2.Cells(r, 4)
Exit Do
End If
r = r ...続きを読む

QエクセルVBA 複数の条件を含む対象を抜き出す。

エクセルVBAについて質問です。
エクセルのバージョンは2003と2007を主に使用しています。

下記の様なデータがあるときに、部活が「野球」でかつクラブは「囲碁」に入っている生徒の学籍番号を別のシート(Sheet2)のB3から下に順にリスト化するマクロがどうしても出来なくて困っています。
find next等を使うのでは無いかと色々してみましたが上手く出来ない現状です。

<sheet1>
   A      B      C       D    E

1 学籍番号 学年    名前     部活   クラブ
2 2222222   1   山田 太郎  野球   囲碁
3 9854923   2   吉田 次郎   剣道   絵画  
4 1111111   3   佐藤 三郎  野球   囲碁
5 8888883   1   米山 権蔵  卓球   囲碁

Aベストアンサー

こんばんは!
Sheet1のA列(学籍番号)のみをSheet2のB3セル以降に表示すれば良いわけですね?
一例です。

画面左下のSheet1のSheet見出し上で右クリック → コードの表示 → VBE画面に
↓のコードをコピー&ペーストしてマクロを実行してみてください。

Sub test()
Dim i, k As Long
Dim ws As Worksheet
Set ws = Worksheets(2)
k = 2
For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row
If Cells(i, 4) = "野球" And Cells(i, 5) = "囲碁" Then
k = k + 1
ws.Cells(k, 2) = Cells(i, 1)
End If
Next i
End Sub

こんな感じではどうでしょうか?m(_ _)m

QVBAで条件が一致する行のデータを別シートに抽出

"Sheet1"のA列に区分(文字列)、B列~D列に分析数値があり
A列の文字が条件に一致した行のデータを"Sheet2"にコピー、
元の"Sheet1"のデータは行ごと削除といった形で考えているのですが、どうも上手くいきません。

Dim Keywrd As String
???
With Worksheets("Sheet1").Columns("A:A")
Set Keywrd = .Find("キーワード", LookIn:=xlValues)
???
End With
Set Keywrd = Nothing
TargetCell.EntireRow.Select
Selection.Delete Shift:=xlUp
End Sub


???部分の変数宣言と処理内容をどうすれば良いか、ご教授願えますでしょうか。

Aベストアンサー

こんばんは。

#1の回答者です。一度きりなら、こんな風に直してみたらよいと思います。質問のコードは、変数の流れがおかしくなっているようです。

Sub Macro1()
  Dim Keywrd As String
  Dim TargetCell As Range
  Keywrd = InputBox("キーワードを入れてください", "キーワード入力")
  If Keywrd = "" Then Exit Sub
  With Worksheets("Sheet1").Columns("A:A")
    Set TargetCell = .Find(Keywrd, LookAt:=xlWhole, LookIn:=xlValues)
    If TargetCell Is Nothing Then
      MsgBox Keywrd & " は見つかりません。"
      Exit Sub
    End If
  End With
  'Keywrd = "" ''不要
  TargetCell.EntireRow.Copy Worksheets("Sheet2").Range("A1")
  TargetCell.Delete Shift:=xlUp

End Sub

--------------------------------------
#1 のコードを考え直し修正しました。
私のコードは、必ず、検索値に対して複数、該当するものがあるという条件になっています。

---------------------------------------------
Sub TestFind2()
 Dim myKeyWord As String
 Dim FirstAdd As String
 Dim c As Range
 Dim ur As Range
 myKeyWord = Application.InputBox("検索文字を入れてください", "検索+移動", Type:=2)
 If myKeyWord = "" Or myKeyWord = "False" Then Exit Sub

 With Worksheets("Sheet1").Columns(1)
 .Cells(1).Select
 Set c = .Find( _
      What:=myKeyWord, _
      LookIn:=xlValues, _
      LookAt:=xlWhole, _
      MatchCase:=False, _
      MatchByte:=True)

  If Not c Is Nothing Then
     Set ur = c.EntireRow
     FirstAdd = c.Address
    Do
      Set ur = Union(c.EntireRow, ur)
      Set c = .FindNext(c)
    Loop Until (c Is Nothing) Or (FirstAdd = c.Address)
   End If
   ur.Copy Worksheets("Sheet2").Range("A1")
   ur.Delete Shift:=xlShiftUp
End With
   Set ur = Nothing
End Sub


 

こんばんは。

#1の回答者です。一度きりなら、こんな風に直してみたらよいと思います。質問のコードは、変数の流れがおかしくなっているようです。

Sub Macro1()
  Dim Keywrd As String
  Dim TargetCell As Range
  Keywrd = InputBox("キーワードを入れてください", "キーワード入力")
  If Keywrd = "" Then Exit Sub
  With Worksheets("Sheet1").Columns("A:A")
    Set TargetCell = .Find(Keywrd, LookAt:=xlWhole, LookIn:=xlValues)
    If TargetCell Is Nothing Then
...続きを読む

QExel VBA 別ブックから該当データを検索し、必要なデータを取得する方法について

部品表というブックがあります
A列に商品名、B列に商品番号が入力してあります。C列のコードは未入力です。
A列     B列     C列      
商品名  商品番号  コード
モータ  U-1325-L  
ホルダ  R-134256

また、コード一覧表という別のブックには、A列に商品番号と、B列にコードが、何千件も入力されています。

やりたいことは
部品表のC列のコード欄に、コード一覧表ブックから商品番号と一致するコードを貼り付けしたいのです。

部品表は、何百種類もありますので、関数ではなく、マクロで処理を希望します。

自分では、部品表の商品番号をコピーして、コード一覧表で検索し、検索結果の右隣のセル(B列のコード)の値を部品表のC列に貼り付ければよいかと思い、書いてみたんですが…

Sub 別ブックから貼り付ける()
  Dim 検索する As Long
Windows("部品表.xls").Activate
検索する = cells(i,2).Value
Windows("コード一覧表.xls").Activate
ActiveWindow.SmallScroll Down:=-3
Selection.AutoFilter Field:=3, Criteria1:="=検索する", Operator:= xlAnd

と、してみたものの、検索しても、その検索結果の隣のセルのコードをどうやって取得すればいいのかが、わかりませんでした。

基本事項は本で学びましたが、呪文のようなコードはよく理解できません。懸命にネットで検索して、訳して理解する努力をしてはいますが。

どうぞよろしくお願いします。

部品表というブックがあります
A列に商品名、B列に商品番号が入力してあります。C列のコードは未入力です。
A列     B列     C列      
商品名  商品番号  コード
モータ  U-1325-L  
ホルダ  R-134256

また、コード一覧表という別のブックには、A列に商品番号と、B列にコードが、何千件も入力されています。

やりたいことは
部品表のC列のコード欄に、コード一覧表ブックから商品番号と一致するコードを貼り付けしたいのです。

部品表は、何百種類もありますので、関数...続きを読む

Aベストアンサー

こんにちは。
とりあえず実用性も踏まえました。
メインの動作はワークシート関数のVLOOKUPをVBA上で使用していますので理解はしやすいかと思います。
また、質問文から察するに「部品表.xls」と「コード一覧表.xls」の両方を開いて処理されていますが「コード一覧表.xls」はプログラム内で開いて閉じているので実行するときは「コード一覧表.xls」は閉じて置いてください。
Option Explicit
Sub Sample()
 Application.ScreenUpdating = False
 Dim I As Long
 Dim xlBook
 Set xlBook = Workbooks.Open("C:\★★\コード一覧表.xls") '★要変更★
 I = 2
 Do While Range("A" & I).Value <> ""
  ThisWorkbook.Worksheets("Sheet1").Range("C" & I).Value = Application.VLookup(ThisWorkbook.Worksheets("Sheet1").Range("B" & I).Value, xlBook.Worksheets("Sheet1").Range("A2:B65535"), 2, 0)
  I = I + 1
 Loop
 xlBook.Close
 Application.ScreenUpdating = True
 MsgBox ("完了")
End Sub

こんにちは。
とりあえず実用性も踏まえました。
メインの動作はワークシート関数のVLOOKUPをVBA上で使用していますので理解はしやすいかと思います。
また、質問文から察するに「部品表.xls」と「コード一覧表.xls」の両方を開いて処理されていますが「コード一覧表.xls」はプログラム内で開いて閉じているので実行するときは「コード一覧表.xls」は閉じて置いてください。
Option Explicit
Sub Sample()
 Application.ScreenUpdating = False
 Dim I As Long
 Dim xlBook
 Set xlBook = Workbooks....続きを読む

Q複数条件が一致で別シートに転記【エクセルVBA】

エクセルでセルの条件が複数一致したら別シートに転記される方法をお教えください。
シートを2枚用意して、配達日ごとに一覧化したいのです。
事前に用意したシート(配達表)の“配達”と“配達時間”が一致したら
その方の名前と注文個数を右側に反映したいのですが・・・

注文データが多すぎて困っています。
宜しくお願いします。

■シート名:注文データ
   A    B    C    D    E
------------------------------------------------
1 しめい  対応   配達日   時間   個数
------------------------------------------------
2 たけだ  配達  6/20(月) 13:00  2個
3 みうら  配達  6/18(土) 14:00  4個
4 らもす  郵送  6/20(月)  ―   5個
5 いはら  配達  6/20(月) 14:30  8個
6 かつや  配達  6/20(月) 15:00  6個
7 みうら  郵送  6/20(月)  ―   4個

■シート名:配達表
    A     B    C
------------------------------------
1  配達   6/20(月)
------------------------------------
2  12:00
3  12:30
4  13:00
5  13:30
6  14:30
7  15:00
8  15:30
9  16:00

マクロを実行すると・・・
↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓

■シート名:配達表
    A     B    C
------------------------------------
1  配達   6/20(月)
------------------------------------
2  12:00 
3  12:30
4  13:00    たけだ   2個
5  13:30
6  14:00    みうら   4個
6  14:30   いはら   8個
7  15:00   かつや   6個
8  15:30
9  16:00

エクセルでセルの条件が複数一致したら別シートに転記される方法をお教えください。
シートを2枚用意して、配達日ごとに一覧化したいのです。
事前に用意したシート(配達表)の“配達”と“配達時間”が一致したら
その方の名前と注文個数を右側に反映したいのですが・・・

注文データが多すぎて困っています。
宜しくお願いします。

■シート名:注文データ
   A    B    C    D    E
------------------------------------------------
1 しめい  対応   配達日   時間   個数
-...続きを読む

Aベストアンサー

こういうのは「複数条件による抜き出し問題」だ。
関数で出来ればおなじみのやり方で良いのだが、既に出ているように式が長く複雑で、初心者には何をやって居るかわからない式になる。毎度週に数回このタイプの質問が出て、同じようなタイプの答えになる。Googleででも「imogasi方式」で照会すれば、過去の沢山の例と回答(そのタイプも)が出てくる。
ーー
まず初心者や急ぐ場合はデーターフィルターフィルタオプションの設定で済ませられないか勉強すべきだ。
ーー
本来、こういう仕事の関連のエクセル表は、VBAを勉強してそれを使うべきと思う(既に回答も出ているようだ)
関数で抜き出し問題や表の組み換えは、VBAで無いと、天下りの長い式をコピペで使うだけになる。
ーー
私が紹介している「imogasi方式」では、Sheet2に時刻の所定の行に出す問題なので複雑になりすぎる。
ーー
VBAでやってみる。
例データ
しめい対応配達日時間個数
たけだ配達6月20日13:002個
みうら配達6月18日14:004個
らもす郵送6月20日ーー5個
いはら配達6月20日14:308個
かつや配達6月20日15:006個
みうら郵送6月20日ーー4個
(注意)
「ーー」セルは空白とする
「月日」列は、エクセルの年月日を入れておくこと(日付シリアル値(わかりますか)) 文字列では不可
6/20(月) の様な表示は、表示形式の設定でやること(エクセルの常識)  m/d(aaa)
時間の列も時刻シリアル値で入れてあるとする。文字列では不可
ーー
コード
標準モジュールに
Sub test01()
Dim sh1, sh2
Set sh1 = Worksheets("Sheet1")
Set sh2 = Worksheets("Sheet2")
d = sh1.Range("A65536").End(xlUp).Row
On Error Resume Next
For i = 2 To d
'--条件をかけて選別
If sh1.Cells(i, "B") = "配達" And sh1.Cells(i, "C") = sh2.Range("B1") And _
sh1.Cells(i, "D") <> "" Then
t = sh1.Cells(i, "D")
'---Sheet2で時刻行を探す
For r = 2 To 30
If sh1.Cells(i, "D") = sh2.Cells(r, "A") Then Exit For
Next r
'--該当行の値をSheet2の時刻該当行セット
Sheet2.Cells(r, "B") = sh1.Cells(i, "A")
Sheet2.Cells(r, "C") = sh1.Cells(i, "E")
End If
Next i
End Sub
ーー
実行結果
Sheet2
配達6月20日
12:00
12:30
13:00たけだ2個
13:30
14:00
14:30いはら8個
15:00かつや6個
15:30
16:00
・・・・・・

こういうのは「複数条件による抜き出し問題」だ。
関数で出来ればおなじみのやり方で良いのだが、既に出ているように式が長く複雑で、初心者には何をやって居るかわからない式になる。毎度週に数回このタイプの質問が出て、同じようなタイプの答えになる。Googleででも「imogasi方式」で照会すれば、過去の沢山の例と回答(そのタイプも)が出てくる。
ーー
まず初心者や急ぐ場合はデーターフィルターフィルタオプションの設定で済ませられないか勉強すべきだ。
ーー
本来、こういう仕事の関連のエクセル表...続きを読む

Q【excelVBA】Findメソッドで検索対象を複数列

findメソッドで、検索対象を複数列&検索条件を複数にしたいのですが、可能でしょうか?
イメージ的には、下のようなデータが入っているシートから、
AとB列を条件にしてC列の同じ行の値を取得したいのです。
A |B |C
00|00|01
00|00|02
00|01|01
Range("A:B").Find(what:="00"&"00"・・・)のような感じです。
→期待される取得結果は01と02です。

今のところ方法がおもいつかないので、
(1)A列を条件にしB列
(2)(1)のB列を条件にしC列
と二段階で取得するしかないかな~と思っています。

このような処理は不可能でしょうか?また可能ならばその記述方法をご教授ください。よろしくお願いします。

Aベストアンサー

こんにちは。

どこか空いている列に"=A1&B1"のような数式を入れて、
下へコピーします。
そして、その列を対象にして、"0000"を検索すれば良いのでは?

もし、空いている列が無いのであれば、A列とB列の文字列を
結合しながら、"0000"とイコールかどうか評価するという
動作を1行目からループさせる方法でも良いかもしれません。

一応、A列 & B列が"0000"になる行のC列の値を
イミデイエイトに列挙するサンプルです。↓

Option Explicit

Sub Sample()

Dim i As Long
Dim j As Long

With ActiveSheet
j = .Range("A1").CurrentRegion.Rows.Count

For i = 1 To j
If .Cells(i, 1).Value & .Cells(i, 2).Value = "0000" Then
Debug.Print .Cells(i, 3).Value
End If
Next
End With

End Sub

こんにちは。

どこか空いている列に"=A1&B1"のような数式を入れて、
下へコピーします。
そして、その列を対象にして、"0000"を検索すれば良いのでは?

もし、空いている列が無いのであれば、A列とB列の文字列を
結合しながら、"0000"とイコールかどうか評価するという
動作を1行目からループさせる方法でも良いかもしれません。

一応、A列 & B列が"0000"になる行のC列の値を
イミデイエイトに列挙するサンプルです。↓

Option Explicit

Sub Sample()

Dim i As Long
Dim j As Long

With...続きを読む

QEXCEL VBA で現在開いているブックのファイル名を取得する方法

EXCEL2003 VBAで業務を簡素化するために、現在開いているブックのファイル名を取得する方法が分かりません。
作業手順をマクロを使って処理していますが、オリジナルのワークブックをファイル名を変えて保存し、以後、このワークブックを読み込んで使用しています。
このときのVBAは、オリジナルのファイル名を使っているため、ファイル名を変更するとエラーになり、以後の業務に使用できません。
常にファイル名を取得出来るVBAをどなたか、教えて下さい。

Aベストアンサー

>現在開いているブックのファイル名
 ちょっと曖昧な表現かなぁという気もいたしますが、VBAが書いてあるブックのブック名は
ThisWorkbook.Name
で、現在 "アクティブにして" 操作対象になっているブックの名前は
ActiveWorkbook.Name
ですね。

 しかし、
>VBAは、オリジナルのファイル名を使っているため、ファイル名を変更するとエラーになり
というような文脈からすると、
ThisWorkbook.Name
の方ですかね。

Q複数の条件に合う行番号を取得するには

行列 A列 B列 C列 D列
 1  No  Kg  3  32
 2  1  30
 3  1  31
 4  1  32
 5  1  33
 6  1  34
 7  2  27
 8  2  28
 9  2  29
10  2  30
11  3  31
12  3  32
13  3  33



上表の通り、A列とB列がデータ(1行目はヘッダー)、セル番号C1とD1が検索条件です。
C1の検索条件はA列、D1の検索条件がB列です。

この2つの条件に合う行番号を取得できるようにVBAを作成しております。
上記例ですと、行番号(アウトプット)は12行目となります。

以下のようにMatch関数では複数条件での検索ができなそうです。
(以下は当然エラーとなってしまいます)

調べていると、IndexやFind 関数を使用している例も見ましたが、うまくいきません。

複数の条件から該当する行番号を返す方法をご教授いただきたくお願いします。




Sub test()

Dim row As Variant

row = Application.Match(Range("C1") & Range("D1"), Range("A2:A13") & Range("B2:B13"), 0)

If IsError(row) Then

MsgBox "該当データが見つかりません"
Else

MsgBox row & "番めのデータです"

End If

End Sub

行列 A列 B列 C列 D列
 1  No  Kg  3  32
 2  1  30
 3  1  31
 4  1  32
 5  1  33
 6  1  34
 7  2  27
 8  2  28
 9  2  29
10  2  30
11  3  31
12  3  32
13  3  33



上表の通り、A列とB列がデータ(1行目はヘッダー)、セル番号C1とD1が検索条件です。
C1の検索条件はA列、D1の検索条件がB列です。

この2つの条件に合う行番号を取得できるようにVBAを作成しておりま...続きを読む

Aベストアンサー

こんにちは。

Match関数は、VBAではよく使いますが、主に、1次元配列で使われるものですから、今回のようなものには不向きです。また、VBAでは、配列関数はほとんど使われません。なぜかというと不要だからです。Macro3 をみてください。

この3つのマクロを比べてみてください。
ただし、該当するデータは複数入れてみるとよいです。

3 32  複数ある場合。
3 32
33 2 合わせると同じ文字になってしまう場合

本来は、これらを想定して作らなくてはならないはずです。

最後に、ユーザー定義関数(UDF)を加えて置きましたが、これは、配列の出力がありますから、複数の場合は、INDEX関数などが必要です。下手なマクロかもしれませんが、少しでも参考になればと思いました。

'---------------------
Sub Macro1()
Dim c As Range
Dim a As Variant
Dim b As Variant
Dim adr As String
a = Range("C1").Value
b = Range("D1").Value
For Each c In Range("A2", Cells(Rows.Count, 1).End(xlUp))
  If c.Value = a Then
    If c.Offset(, 1).Value = b Then
      adr = adr & "," & c.Address(0, 0)
     End If
   End If
Next c
 If Len(adr) > 1 Then
    MsgBox Mid(adr, 2)
 Else
    MsgBox "該当のセルは見つかりません", vbExclamation
 End If
End Sub
'------------------
Sub Macro2()
  Dim rw As Variant
  '=MATCH(検査値,検査範囲,照合の種類)
  Dim a As Variant
  Dim b As Variant
  Dim i As Long
  Dim ar1 As Variant
  Dim ar2 As Variant
  ar1 = Application.Transpose(Range("A2:A15").Value)
  ar2 = Application.Transpose(Range("B2:B15").Value)
  a = Range("C1").Value
  b = Range("D1").Value
  For i = LBound(ar1) To UBound(ar1)
    ar1(i) = ar1(i) & "," & ar2(i)
  Next i
  rw = Application.Match(a & "," & b, ar1, 0)
  If IsNumeric(rw) Then
    MsgBox rw & "番めのデータです"
  Else
    MsgBox "該当データが見つかりません", vbExclamation
  End If
End Sub
'---------------
Sub Macro3()
Dim i As Variant
   i = Evaluate("SUM((A1:A15=C1)*(B1:B15=D1)*ROW(A1:A15))")
   If i <> 0 Then
      MsgBox i
   Else
      MsgBox "該当のデータが見つかりません", vbExclamation
   End If
End Sub
'------------------
Function SearchMatch(ser1, ser2, rng1 As Range, rng2 As Range)
'これは配列関数です。
  Dim RwCnt As Long: RwCnt = rng1.Rows.Count
  Dim i As Long, j As Long
  Dim Ar As Variant
  Dim Ret() As Variant
  ser1 = Trim(ser1)
  ser2 = Trim(ser2)
  ReDim Ar(1 To RwCnt)
  For i = 1 To RwCnt
    Ar(i) = rng1.Cells(i, 1).Value & "," & rng2.Cells(i, 1).Value
    If ser1 & "," & ser2 Like Ar(i) Then
       j = j + 1
       ReDim Preserve Ret(1 To j)
       Ret(j) = i
    End If
  Next i
  If j > 0 Then
    SearchMatch = Ret
  Else
    SearchMatch = "n/v"
  End If
End Function

'//
配列の出力は、
例えば、このように出汁ます。
=INDEX(SearchMatch(C1,D1,A2:A14,B2:B14),,1)
=INDEX(SearchMatch(C1,D1,A2:A14,B2:B14),,2) '2にする

こんにちは。

Match関数は、VBAではよく使いますが、主に、1次元配列で使われるものですから、今回のようなものには不向きです。また、VBAでは、配列関数はほとんど使われません。なぜかというと不要だからです。Macro3 をみてください。

この3つのマクロを比べてみてください。
ただし、該当するデータは複数入れてみるとよいです。

3 32  複数ある場合。
3 32
33 2 合わせると同じ文字になってしまう場合

本来は、これらを想定して作らなくてはならないはずです。

最後に、ユーザー定義関数(UDF)を...続きを読む

Qエクセルで複数列の検索をマクロで行いたい

A列、B列、C列に項目が、D列以降にデータが入っているシートがあります。
具体的には、
 A列:商品名
 B列:地域名
 C列:店舗名
となっていて、ABCの順で昇順にソートがかけられています。

マクロの記録を使って一行だけを検索することは出来たのですが、(Selection.find(What:="商品名"~ となっていました)本当は、"商品名"+"地域名"+"店舗名"が一致するものを検索したいのです。

現在は、一行目で検索をかけて、後はactivecell.offset(*,*).value="地域名"のような感じで、しらみつぶしに探しています。

複数列で検索するよい方法などありましたら教えてください。

Aベストアンサー

#2 のWendy02 です。
後で、ミスを見つけましたので、こちらを優先させてください。見つからない場合のことを忘れていませした。(^^;

Sub Sample()
Dim nm As Variant
Dim buf As Variant, i As Long
Dim Rng As Range
With ActiveSheet
Set Rng = .Range("A1").CurrentRegion
.Range("A1:C1").Copy .Range("AA1")
For Each nm In Array("商品名", "地域名", "店舗名")
  Do
  buf = Application.InputBox(nm & "を入れてください。", Type:=2)
  If VarType(buf) = vbBoolean Then Exit Sub
  If buf = "" Then MsgBox nm & "を入れてください。"
  Loop While buf = ""
  .Range("AA2").Offset(, i).Value = buf
  i = i + 1
Next nm
        Rng.AdvancedFilter _
         Action:=xlFilterInPlace, _
         CriteriaRange:=.Range("AA1:AC2"), _
         Unique:=False
 
  On Error Resume Next
  Rng.Offset(1).Resize(Rng.Rows.Count - 1). _
  SpecialCells(xlCellTypeVisible).Select
  If Err.Number > 0 Then
   MsgBox "探しているものは見つかりません", vbCritical
  Else
   .ShowAllData
  End If
  On Error GoTo 0
End With
  Set Rng = Nothing
  Range("Criteria").ClearContents
End Sub

#2 のWendy02 です。
後で、ミスを見つけましたので、こちらを優先させてください。見つからない場合のことを忘れていませした。(^^;

Sub Sample()
Dim nm As Variant
Dim buf As Variant, i As Long
Dim Rng As Range
With ActiveSheet
Set Rng = .Range("A1").CurrentRegion
.Range("A1:C1").Copy .Range("AA1")
For Each nm In Array("商品名", "地域名", "店舗名")
  Do
  buf = Application.InputBox(nm & "を入れてください。", Type:=2)
  If VarType(buf) = vbBoolean Then Exit Sub
...続きを読む

Q別のシートから値を取得するとき

Worksheets("シート名").Activate
上記のを行ってから別シートの値を取得するのですが、
この処理を行うと指定したシートへ強制的にとんでしまいます。。。

※イメージ
For ~ To ~
  Worksheets("シートA").Activate
  シートAの値取得
       :
  Worksheets("シートB").Activate
  シートBの値取得
Next

このイメージ処理を行うとものすごい勢いで画面がチカチカします。。。
シートを変えずに他のシートから値を取得する方法はないのでしょうか。
教えてください!

Aベストアンサー

Worksheets("シートA").Range("A1")

みたいな感じでできませんか?


このQ&Aを見た人がよく見るQ&A

人気Q&Aランキング