[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『複数条件で検索』（える）
装置名 装置名詳細 装置搭載部 搭載部の詳細ﾊﾟｰﾂ ﾊﾟｰﾂ型式 ﾊﾟｰﾂコード
A1号機 A1号機（001） バック部 X軸ネジ DDD 111 Y軸ポール EEE 222 フロント部 Z軸 SSS 333 θ軸 LLL 444
A1号機（002） バック部 X軸ネジ DD1 112 Y軸ポール EEE 222 フロント部 Z軸 SS2 334 θ軸 WWW 0 サイド部 ﾄﾞﾗｲﾊﾞ PPP 555
B1号機 B1号機（001） ライト部 ライト RRR 999 フロント部 Z軸 SSS 333 サイド部 ﾄﾞﾗｲﾊﾞ PPP 555 ヘッド部 モーター MMM 777 B1号機（002） バック部 X軸ネジ DD1 112 Y軸ポール EE2 223
フロント部 Z軸 SS1 331 ID部 基板 KKK 888 B1号機（003） ライト部 ライト RR1 991
C1号機 C1号機（001） ライト部 ライト RRR 999 C1号機（002） ライト部 ライト RR1 991 C1号機（003） バック部 X軸ネジ DD1 112 フロント部 Z軸 SS1 331 C1号機（004） バック部 X軸ネジ DDD 111 フロント部 Z軸 SSS 333
えると申します。また、会社で困った事になってしまいました。。 色々、ここの掲示板で、勉強させてもらっているのですが、中々うまく使うことが できず、力を貸していただけませんでしょうか・・・ A列のような装置があり、その装置には、客先ごとに部品をかえた 下３ｹﾀの数字がついています。 搭載部は、下３ｹﾀに関わらずA列の装置によって、ほぼ決まっています。 搭載部に使われるﾊﾟｰﾂも、ほぼ決まっています。 ですが、ﾊﾟｰﾂのコードは、色々変わってきます。 上司がいうには、例えば、A1号機の002のフロント部のﾊﾟｰﾂコードが知りたいと なったときに、さっと検索できるようにしたいというのですが、 前回教えていただいた入力規則のリストで、A1号機を選択→001～002がでて 001を選択すると、バック部フロント部が選べて～・・・というのが思い浮かんだのですが、 そんないくつも選択できないようでした。。。 何か、他に、いい方法はありませんでしょうか・・・？ 長々とすいません、、宜しくお願いいたします。。
vba処理の一例:
Sheet1にリストがあり、一行目は列見出し...
コードを貼り付けたら、一度他のシートをクリックしてもう一度該当シートに戻る。
該当シートのSheet moduleへ：
Private dic1 As Object, dic2 As Object
Private Sub Worksheet_Activate()
Dim a, i As Long, n As Integer
Set dic1 = CreateObject("Scripting.Dictionary")
Set dic2 = CreateObject("Scripting.dictionary")
dic1.CompareMode = vbTextCompare
dic2.CompareMode = vbTextCompare
a = Sheets("Sheet1").UsedRange.Resize(,6).Value
For i = 2 To UBound(a,1)
If Not IsEmpty(a(i,2)) Then
dic1.add a(i,2), a(i,3)
z = a(i,2) & ";" & a(i,3)
dic2.add z, a(i,4)
n = 1
Do While IsEmpty(a(i + n, 2))
If IsEmpty(a(i + n, 3)) Then
If Not IsEmpty(a(i + n, 4)) Then
dic2(z) = dic2(z) & "," & a(i + n, 4)
End If
Else
dic1(a(i,2)) = dic1(a(i,2)) & "," & a(i + n, 3)
z = a(i,2) & ";" & a(i + n, 3)
dic2.add z, a(i + n, 4)
End If
n = n + 1
If i + n > UBound(a,1) Then Exit Do
Loop
End If
Next
Erase a
With Range("a1")
.Value = ""
With .Validation
.Delete
.Add type:=xlValidateList, formula1:=Join(dic1.keys,",")
End With
.Select
End With
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Target.Address(0,0) = "A1" And Not IsEmpty(Target) Then
With Range("b1")
.Value = ""
With .Validation
.Delete
.Add type:=xlValidateList, formula1:=dic1(Target.Value)
End With
.Select
End With
ElseIf Target.Address(0,0) = "B1" And WorksheetFunction.CountA(Range("a1:b1"))=2 Then
With Range("c1")
.Value = ""
With .Validation
.Delete
.Add type:=xlValidateList, _
formula1:=dic2(Range("a1").Value & ";" & Range("b1").Value)
End With
.Select
End With
End If
Application.EnableEvents = True
End Sub
(seiya)
ご教授、ありがとうございます！！
すいません、私には、VBAの知識があまりないので、色々試してはみたのですが、
＞コードを貼り付けたら、一度他のシートをクリックしてもう一度該当シートに戻る。
というのは、ﾃﾞｰﾀの入っているSheet1に、例えば、１１１というコードをA1に入力後、Sheet２に移り、またSheet1に戻り、ﾃﾞｰﾀのVBAを開いて、組んでいただいたVBAプログラムを
コピペでいいのでしょうか・・・？
初心者なもので、本当にすいません。。
1) 表示させるシート(Sheet1以外)のシートタブを右クリック -> [コードの表示] 2) コードを貼り付け、 x をクリックしてエクセルに戻る 3) 一度コードを貼り付けたシート以外を選択してから、コードを貼り付けたシートを選択
という意味です。 実際に検証してませんので、エラーが出るかもしれません。 エラーが出たら、詳しくお知らせください。 (seiya)
こんな感じで全ての行を埋めて 装置名 装置名詳細 装置搭載部 搭載部の ﾊﾟｰﾂ型式 ﾊﾟｰﾂコード 詳細ﾊﾟｰﾂ A1号機 A1号機（001） バック部 X軸ネジ DDD 111 A1号機 A1号機（001） バック部 Y軸ポール EEE 222 A1号機 A1号機（001） フロント部 Z軸 SSS 333 A1号機 A1号機（001） フロント部 θ軸 LLL 444 オートフィルタで絞り込みたい項目を絞り込む
・・・とかではダメなんですかね？
件数によっては [[20040925171636]]『オートフィルター：1000行ぐらいしか表示しません』（中島） こんな事もあるので注意が必要ですが。
(HANA)
HANAさん
ご意見ありがとうございます！
オートフィルタだと、ﾊﾟｰﾂ型式で検索したいときに、実際の型式は文字数が多く、アルファベット数字の１字違いなどあって、検索を間違えてしまう等、少し使いづらいような気もしたりしていまして・・・
dic(i,2) & "," & a(i + n, 3) は dic1(i,2) & .... です コードを修正しておきましたので、もう一度コピーしなおしてください (seiya)
解決しそうで良かったですね。 そのあとで私のプログラムも投稿してみたいと思います。 マクロではない、ベーシックプログラムの参考にでもなればと思います。 気が向いたら完結後もワッチしてください。 （mr_mangoos）
実行時エラー'450'
引数の数が一致していません。または不正なプロパティを指定しています。
というｺﾏﾝﾄﾞが開くのですが・・・それをﾃﾞﾊﾞｯｸで抜けると、
dic1(a(i, 2)) = dic1(i, 2) & "," & a(i + n, 3)
が一列、黄色くマーカーされたような表示ででてくるのです。。。
すみません、とっても間抜けなことをしています。 dic1(a(i,2)) です。 コード修正済み (seiya)
VBAでされているのに、すみません～。。 数式案で～す。 必要なければ無視してください。
sheet1のデータ行がわかりませんので 1つの式でも出来ますけれど、データ行が多いと 重くなりますので、作業列を使う方法です。
★データシート名 sheet1 sheet1へ
*作業列その１→H列
H2: =IF(COUNTA(D2:F2)<3,"",INDEX(B:B,MATCH("ー",$B$2:B2)+1)&INDEX(C:C,MATCH ("ー",$C$2:C2)+1))
*作業列その２→I列
I2: =IF(H2=Sheet2!$A$2&"号機("&Sheet2!$B$2&")"&Sheet2!$C$2&"部",ROW(),"")
それぞれ下にコピーします。 この作業列は、非表示にしてもいいですね。。。
★抽出シート名 sheet2 ↓
Ａ Ｂ Ｃ Ｄ １ 装置名 装置名 詳細装置搭載部 ﾊﾟｰﾂコード ２ A1 002 フロント 334 ３ 0
こんな感じにA2～C2へ入力します。 (B2セルは、書式→文字列) この入力は入力規則を使ってもいいですね。 D3の 0 は、例題の表で 0 になっていましたので。
式は、 D2: =IF(COUNT(Sheet1!$I:$I)<ROW(A1),"",INDEX(Sheet1!$F:$F,SMALL(Sheet1! $I:$I,ROW(A1))))
下にコピーします。
ご参考にどうぞ～。。。。
。。。。(Ms.in)でした～♪♪
↑ あれ！！
そそっかしいので～。 HNの R が、抜けていました。
(Ms.Rin)でした～♪♪
Ms,Rinさん
ご提案、ありがとうございます！！
関数をいくつか使うと、こんなこともできるんですね・・・
他の場面でも使えますよね！
ありがとうございます！
区切り目挿入（10/27 15:45） （dack）
項目はデタラメで結構ですから、詳しいレイアウトをご提示ください。 (seiya)
もうご用済みでしょうが載せさせて下さい、こんな方法もあります。
◇条件として、検索されるデータはＳＨＥＥＴ№のSHEET1の２行目以降から始まっていて、
横にＡ～Ｆと展開しているものとして作成してます。
お願い：データの最後の行の次のセルのＡ列に半角の*を入れて下さい（無くても良いです
がデータの終りを判定したいので）
下記プログラムをコピーして貼り付けした後でSHEET№のSHEET2のセルF3あたりにオートシ
ェイプから
適当な図形を貼り付けてください。（二重四角みたいになっている図形をお勧めします）
その後で図形を右クリックしてマクロの登録で｢検索｣を登録して下さい。
これで準備完了です。
今のSHEET2のセル｢J1｣に検索のキーワード、装置名詳細（例えば：Ａ1号機（002））
と入力して先ほどの貼り付けた図形をクリックして下さい。
装置名詳細でくくられるグループが検索されて５行目以降に表示されます。
＊検索結果がお気に召すかわかりませんが載せてみました。
mr_mangoos
Sub 検索()
Dim i, J, CTL
Dim F1 As Boolean
CTL = 5
Range(Sheet2.Cells(5, 1), Sheet2.Cells(50, 6)).ClearContents
F1 = False
For i = 1 To 2000
If (Sheet1.Cells(i, 1) = "*") Then Exit Sub
If (Sheet1.Cells(i, 2) = "") Then
Else
If (Trim(Sheet2.Cells(1, 10)) = Trim(Sheet1.Cells(i, 2))) Then
F1 = True
Else
F1 = False
End If
End If
If (F1 = True) Then
For J = 2 To 6
Sheet2.Cells(CTL, J) = Trim(Sheet1.Cells(i, J))
Next J
CTL = CTL + 1
End If
Next i
End Sub
mr_mangoosさん
ありがとうございます！
seiyaさん
会社のPCの調子が悪く遅くなりました。。申し訳ありません。。。
検索したい列数なのですが、２０列ほどありました・・・
本当に無理なお願いばかりすいません・・・
レイアウトは
A列には6行、B列には5行、C列には3行、D列には20行、E列には60行、F列には7行、G列には40行・・・といった感じで、たてに情報がならんだデータベースになっています・・
って、回答になっていますでしょうか。。？
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.