入力規則のドロップダウンリストですが、次のような使い方は可能でしょうか?また可能なら方法を教えて頂けませんか?よろしくお願いします。

A、B列にドロップダウンリストを設定し、A列のリストに値を複数設定し、B列のリストの値をA列の値によって変化させたいのですが・・・。各列とも、複数行にわたってドロップダウンリストを設定しています。

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

A 回答 (4件)

では具体例を簡単に示します。


1,セルA1に入力規制をかけて、リストの範囲をC1:C2としてください。
2,セルC1に"TRUE"、セルC2に"FALSE"と記入します。
(A1のドロップダウンリストには"TRUE"と"FALSE"が表示されますね)
3,セルB1に入力規制をかけて、リストの範囲をD1:D2としてください。
4,セルD1に"=IF(A$1=TRUE,E1,F1)"と記入し、セルD2までコピーします。
5,セルE1,E2,F1,F2に適当な文字を入れます。
これで、A1のドロップダウンでTRUEを選択した場合はB1のドロップダウンにE1,E2のりストが、A1のドロップダウンでFALSEを選択した場合はB1のドロップダウンにF1,F2のりストが表示されますね。
要は、B1のリストをあらかじめ別に用意しておいて、A1の選択結果によってB1のドロップダウンのリストの範囲に表示させる値を変化させるということです。
この例では、用意したリストが2列しかないのでIF関数で単純に分けましたが、列が増えるとHLOOKUP関数などを使う必要があります。検索関数の使い方についてはヘルプを参照してください。
    • good
    • 0
この回答へのお礼

具体的で丁寧なお返事、とてもうれしいです。
上記の通り、2列分はできました。
少し検索関数の使い方を見てみながら、列を増やした場合を想定してみます。
ありがとうございました。

お礼日時:2001/05/10 13:01

こんにちは



 以下のページがご参考になるのでは?

【エクセル技道場】-入力規則-縦横可変範囲の名前定義でリスト
http://www2.odn.ne.jp/excel/waza/validation.html …

参考URL:http://www2.odn.ne.jp/excel/waza/validation.html …
    • good
    • 0
この回答へのお礼

ありがとうございます。
何とか思っているようなものができそうです。

お礼日時:2001/05/10 13:02

pochitamaさんこんにちは


可能です。
B列のリストの選択範囲を直接変える場合はVBAで行いますが、B列のリストの選択範囲に検索の関数を入れておいて、その関数の検査値をA列のドロップダウンリストの値に参照してやれば、A列ドロップダウンリストの選択結果によってB列ドロップダウンリストの値が変わりますから、お望み通りになると思いますよ。
- EXCEL2000にて動作確認 -
    • good
    • 0
この回答へのお礼

お返事ありがとうございます。
「可能」という事がわかり嬉しかったです。
さっそく自分でやってみたのですが上手くいきません・・・
Excelの関数もあまり詳しくないのですが、A列の値を参照するのは理解していると思うのですが、その値をどうやってドロップダウンリストの値に反映させるのかが分かりません。
もし宜しかったら、具体的な内容を教えて頂けませんか?

お礼日時:2001/05/09 11:10

入力規則の機能だけでは実現できません。


VBAを操作する必要があります。
VBAまでやる気があれば、再質問してください。
    • good
    • 0

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

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

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

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

Qエクセル プルダウンの作り方

お世話になります。
エクセルでプルダウンの作り方を教えていただけませんでしょうか?
住所を▼のボタンでクリックしたら【北海道,青森,秋田,岩手・・・】などの選択ができるようにしたいのです。
宜しくお願いします。

Aベストアンサー

メニューから「データ」、「入力規則」、「設定」で「入力値の種類」を「リスト」を選択します。
そうすると「元の値」という表示がでますので、そこで前もって作っておいたリストの範囲を指定します。
多くないのでしたら、そのままそこにカンマで区切って入力しても出来ます。

QA列とB列の重複を抽出したいのですがA列とB列の値は一部だけ同じ文字です。ご教示お願いします。

エクセル初心者です。重複を見つけるのが仕事です。いろいろやってみたのですがうまくできません。
お知恵をお貸しください。

A列には企業名が入力されています。
B列にも企業名が入力されていますが全く同じ文字ではないのです。

たとえばこういうことです。
A1 (有)雪見酒      B1  雪見
A2 株式会社豪雪地帯   B2 (株)豪雪地帯
A3 ゆきかき本舗     B3 (有)ゆきかき本舗

A列にある企業名とB列にある企業名が同じであればセルを塗りつぶすか○を表示させるように
したいのです。
重複を見つけるのが目的なので、ほかの方法でもかまいません。
すみません、A列のセルとB列のセルが全く同じ名前ならば重複が見つけられたのですが
ここから先がどうしてもわからないのです。。。
申し訳ありませんがどうか教えてください。。。

Aベストアンサー

No4です。以下のマクロを標準モジュールへ登録してください。
--------------------------------------------------
Option Explicit
Public Sub 重複チェック()
Dim maxrow1 As Long
Dim maxrow2 As Long
Dim row1 As Long
Dim row2 As Long
Dim nameT1() As String
Dim nameT2() As String
Dim t1, t2 As Variant
t1 = Time
maxrow1 = Cells(Rows.Count, "A").End(xlUp).row '最大行取得
maxrow2 = Cells(Rows.Count, "B").End(xlUp).row '最大行取得
ReDim nameT1(maxrow1)
ReDim nameT2(maxrow2)
Range("C1:" & "D" & maxrow2).Value = ""
Call makeTable(nameT1, "A", maxrow1)
Call makeTable(nameT2, "B", maxrow2)
For row1 = 1 To maxrow1
For row2 = 1 To maxrow2
If Cells(row2, "C") = "" Then
If Mymatch(nameT1(row1), nameT2(row2)) = True Then
Cells(row2, "C").Value = "○"
Cells(row2, "D").Value = row1
End If
End If
Next
Next
t2 = Time
MsgBox ("チェック完了 処理時間=" & Minute(t2 - t1) & "分" & Second(t2 - t1) & "秒")
End Sub
'余分な文字を削除した結果をテーブルに格納する
Private Sub makeTable(ByRef nameT() As String, ByVal col As String, ByVal maxrow As Long)
Dim row As Long
Dim ary As Variant
Dim name As String
Dim i As Long
ary = Array("㈱", "(株)", "株式", "(有)", "有限", "会社")
For row = 1 To maxrow
name = Cells(row, col).Value
For i = 0 To UBound(ary)
name = Replace(name, ary(i), "")
Next
nameT(row) = name
Next
End Sub
'企業名が一致かどうか判定する
Private Function Mymatch(ByVal name1 As String, ByVal name2 As String) As Boolean
Mymatch = False
Dim pos As Variant
pos = InStr(1, name1, name2, vbTextCompare)
If pos > 0 Then Mymatch = True
End Function
-----------------------------------------------------
一致の精度が悪ければその旨補足してください。
(一致すべきものが一致しない、一致してはいけないものが一致している)
100%解決できる保証はありませんが、多少のチューニングは行います。

No4です。以下のマクロを標準モジュールへ登録してください。
--------------------------------------------------
Option Explicit
Public Sub 重複チェック()
Dim maxrow1 As Long
Dim maxrow2 As Long
Dim row1 As Long
Dim row2 As Long
Dim nameT1() As String
Dim nameT2() As String
Dim t1, t2 As Variant
t1 = Time
maxrow1 = Cells(Rows.Count, "A").End(xlUp).row '最大行取得
maxrow2 = Cells(Rows.Count, "B").End(xlUp).row '最大行取得
ReDim ...続きを読む

Qエクセルでプルダウンメニューの作り方

  エクセルの画面で、よく三角形を逆さまにした形をクリックするといくつかメニューが出てき、どれかを選べるようになっていますが、その作り方を教えてください。
 会社で人事を担当していますが、三角形(プルダウンボタン)をクリックすると社員氏名一覧が表示され、そこから選択できるようにしたいのです。
 しばらく自力でいろいろやってみましたが、さっぱり見当がつかず、どうやればいいのか分かりませんでした。よろしくお願いします。

Aベストアンサー

こんばんは!
当方使用のExcel2003での一例です!

↓の画像のようにSheet2に名簿表を作成しておきます。
画像ではSheet2のA2セル以降を範囲指定 → 名前ボックスに仮に「名簿」と入力しOK
これで範囲指定したセルが「名簿」と名前定義されましたので、

Sheet1のリスト表示させたいセルを範囲指定 → メニュー → データ → 入力規則
→ リスト → 「元の値」の欄に
=名簿
としてOK

これでSheet1のセルをアクティブにすると右側に下向き▼が表示されますので、そこをクリック!
これで希望に近い形にならないでしょうか?
Excel2007の場合は↓のURLが参考になるかもしれません。

http://www.eurus.dti.ne.jp/~yoneyama/Excel2007/excel2007-ny_kis2.html

尚、同一Sheetに「名簿表」を作成する場合は名前定義する必要はなくて
「元の値」の右側の四角をクリックし、リスト表示したいセルをそのまま範囲指定すればOKです。

以上、お役に立てば良いのですが・・・m(_ _)m

こんばんは!
当方使用のExcel2003での一例です!

↓の画像のようにSheet2に名簿表を作成しておきます。
画像ではSheet2のA2セル以降を範囲指定 → 名前ボックスに仮に「名簿」と入力しOK
これで範囲指定したセルが「名簿」と名前定義されましたので、

Sheet1のリスト表示させたいセルを範囲指定 → メニュー → データ → 入力規則
→ リスト → 「元の値」の欄に
=名簿
としてOK

これでSheet1のセルをアクティブにすると右側に下向き▼が表示されますので、そこをクリック!
これで希望に近い形にならない...続きを読む

QExcel2013 VBA A列とB列の文字をA列とB列とC列に移動させる方法

A列とB列に文字が入っているのですが、下記のようにA列とB列とC列に文字を移動させたいです。
(A列の数字は必ず奇数のA列に入っています。)
VBAのコードを教えて下さい。

例えば
A1 1  B1 cat
A2 空白 B2 猫
A3 空白 B3 dog
A4 空白 B4 犬
A5 2  B5 whale
A6 空白 B6 クジラ
A7 3  B7 rabbit
A8 空白 B8 ウサギ

とデータがある場合

A1 1  B1 cat  C1 猫
A2 空白 B2 dog  C2 犬
A3 2  B3 whale  C3 クジラ
A4 3  B4 rabbit C4 ウサギ

としたいです。

実際、データは、A5196まであります。

Aベストアンサー

No.1です。

>実際、データは、A5196まであります。

前回のコードは一つずつカット&ペーストしていますので
かなりの時間を要すると思います。
↓のコードに変更してみてください。

Sub Sample2()
Dim lastRow As Long
lastRow = Cells(Rows.Count, "B").End(xlUp).Row
Application.ScreenUpdating = False
With Range(Cells(1, "C"), Cells(lastRow, "C"))
.Formula = "=IF(MOD(ROW(),2)=1,B2,"""")"
.Value = .Value
.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End With
Application.ScreenUpdating = True
MsgBox "完了"
End Sub

少しは短縮できると思います。m(_ _)m

No.1です。

>実際、データは、A5196まであります。

前回のコードは一つずつカット&ペーストしていますので
かなりの時間を要すると思います。
↓のコードに変更してみてください。

Sub Sample2()
Dim lastRow As Long
lastRow = Cells(Rows.Count, "B").End(xlUp).Row
Application.ScreenUpdating = False
With Range(Cells(1, "C"), Cells(lastRow, "C"))
.Formula = "=IF(MOD(ROW(),2)=1,B2,"""")"
.Value = .Value
.SpecialCells(xlCellTypeB...続きを読む

Qエクセル(Excel) 納品書の作り方【画像修正版

昨日http://oshiete.goo.ne.jp/qa/7348426.htmlで質問させていただき、詳しくご回答いただき少し進んだのですが、状況が変わったので改めて質問させていただきます。

■エクセル(Excel)で納品書の作成をしています。
シート1に納品書、シート2に商品マスタ(一覧)を作っていて、シート2の一覧を反映させて
納品書に番号を打ち込むだけで、商品名・単価までが出るシステムを作りたいのですが、
昨日のご回答の中の「VLOOKUP」?を入れて、自分なりにマス目の数字を変えてやってみたのですが
反映されずN/?のようなエラーになってしまいます。

※画像が見にくかったのでシート<CENTER></CENTER>だけにしました。

1、上記のように、シート2との関連付けの係数を、写真の場合の数字で教えてください。

2、合計と、合計から20%を引いた数値を割り出す関数も、写真の数字で御願いします。

宜しくご教授お願い致します。

Aベストアンサー

こんばんは!
前回投稿した者です。

当方もかなり古い(人間も古い!なぁ~んちゃって!)Excel2003を使用しています。
↓の画像のようにSheet2にデータを作成しておきます。

#N/A というエラーは、「検索値」がない!ということですので
お示しの画像のB列にSheet2のA列にないデータを入力するとそういったエラーが表示されます。

画像のセル配置ですと
C4セルに
=IF($B4="","",VLOOKUP($B4,Sheet2!$A:$C,COLUMN(B1),0))
(「$」マークの位置に気を付けてください)
という数式を入れD4セルまでオートフィルでコピー!
そのまま最後の24行目までコピーしておきます。

F4セルには
=IF(COUNTBLANK(B4:E4),"",D4*E4)
という数式を入れ、F24までオートフィルでコピー!

これでB列に商品番号を入力すればSheet2のデータが反映され、
E列に数量を入力でF列に金額が表示されると思います。

最後に合計金額のF26セルは
=IF(COUNT(F4:F24),SUM(F4:F24),"")
手数料のF27セルは
=IF(F26="","",F26*0.2)

これで何とか形にならないでしょうか?

※ 振込金額の欄は不明ですので手を付けていません。

参考になりますかね?m(_ _)m

こんばんは!
前回投稿した者です。

当方もかなり古い(人間も古い!なぁ~んちゃって!)Excel2003を使用しています。
↓の画像のようにSheet2にデータを作成しておきます。

#N/A というエラーは、「検索値」がない!ということですので
お示しの画像のB列にSheet2のA列にないデータを入力するとそういったエラーが表示されます。

画像のセル配置ですと
C4セルに
=IF($B4="","",VLOOKUP($B4,Sheet2!$A:$C,COLUMN(B1),0))
(「$」マークの位置に気を付けてください)
という数式を入れD4セルまでオートフィルで...続きを読む

Q【EXCEL】条件付き書式、A列、C列、D列、E列が同じ値の時にB列の背景色を変えたい

お世話になります。

エクセルの条件付き書式の数式の使い方について教えて下さい。
A列、C列、D列、E列の値が同じ時にB列のセルの背景を青に
塗りつぶしたいと思っています。

なので、「数式を使用して、書式設定するセルを決定」、
「次の数式を満たす場合に値を書式設定」で、数式を
「=A1=C1=D1=E1」と入力し、書式、塗りつぶし、青、
を選択して、条件付き書式を設定しました。
すると、、、画像のような結果になります。

私の感覚だと画像でセルの値が「11」~「15」の時だけ
B列が青になると思うのですが実際の結果は画像の通りです。

先の話の通りA列、C列、D列、E列の値が同じ時だけ
B列のセルの背景を青にしたい場合はどうい数式になるのでしょうか?

すいませんが、詳しい方、数式(関数?)で説明できる方よろしくお願い致します。

追記
可能でしたらA列、C列、D列、E列が空白の時はB列の背景色をなしにしたいと思っております。
→A列、C列、D列、E列に値があって、かつ同じ値の場合のみB列の背景を青にしたいです。

お世話になります。

エクセルの条件付き書式の数式の使い方について教えて下さい。
A列、C列、D列、E列の値が同じ時にB列のセルの背景を青に
塗りつぶしたいと思っています。

なので、「数式を使用して、書式設定するセルを決定」、
「次の数式を満たす場合に値を書式設定」で、数式を
「=A1=C1=D1=E1」と入力し、書式、塗りつぶし、青、
を選択して、条件付き書式を設定しました。
すると、、、画像のような結果になります。

私の感覚だと画像でセルの値が「11」~「15」の時だけ
B列が青にな...続きを読む

Aベストアンサー

AND関数を使えば判定ができるのでは?
 =AND(A2<>"",A2=C2,C2=D2,D2=E2)

A列には常に判定する数値が入っているなら「A2<>""」は不要です。

参考サイト
http://www.relief.jp/itnote/archives/003940.php

Qエクセル(Excel) 納品書の作り方【改めて】

昨日http://oshiete.goo.ne.jp/qa/7348426.htmlで質問させていただき、詳しくご回答いただき少し進んだのですが、状況が変わったので改めて質問させていただきます。

■エクセル(Excel)で納品書の作成をしています。
シート1に納品書、シート2に商品マスタ(一覧)を作っていて、シート2の一覧を反映させて
納品書に番号を打ち込むだけで、商品名・単価までが出るシステムを作りたいのですが、
昨日のご回答の中の「VLOOKUP」?を入れて、自分なりにマス目の数字を変えてやってみたのですが
反映されずN/?のようなエラーになってしまいます。

※画像が貼り付けてあります。商品名は1番以外伏せさせていただいています。
くっつけてありますが、左側がシート1・右側がシート2です。

1、上記のように、シート2との関連付けの係数を、写真の場合の数字で教えてください。

2、合計と、合計から20%を引いた数値を割り出す関数も、写真の数字で御願いします。

宜しくご教授お願い致します。

Aベストアンサー

画像がいまいちよく見えないのですが、納品書の項目は左から、No、商品番号、商品名、単価、数量、金額でいいのでしょうか(名前は多少違っていても意味があっていればもんだいないです)

でしたら、
C1セルに=IF(ISBLANK(B2),"",VLOOKUP(B2,Sheet2!$A$2:$C$200,2,FALSE))
D1セルに=IF(ISBLANK(B2),"",VLOOKUP(B2,Sheet2!$A$2:$C$200,3,FALSE))
E1セルは空白で
F1セルに=IF(D2="","",D2*E2)
といれて、C1からF1までをコピーしてその下の行にタテに貼り付ければ出来ますよ。
おそらくエラーが出たのは、コピーしたときにVLOOKUP関数の最初のセルの指定がずれてしまっているのでは無いかと思いますよ。     

Q例えば、AさんからGさんまでがA列に縦に並んでいてB列に数字が入っています。B列にある数字の合計をA

例えば、AさんからGさんまでがA列に縦に並んでいてB列に数字が入っています。B列にある数字の合計をA-Gさん別々に出したいんですが簡単なvbaの記述方法はないでしょうか?
お願いします。

Aベストアンサー

こんばんは!

A列のA~Gさんは複数存在しているのでしょうか?
そうであればSUMIF関数で対応できると思いますが、VBAをお望みだというコトですので
一例です。

元データはSheet1にあり、Sheet2に表示するとします。
尚、Sheet1の1行目は項目行でデータは2行目以降にあるという前提です。
標準モジュールにしてください。

Sub Sample1()
Dim lastRow As Long, wS As Worksheet
Set wS = Worksheets("Sheet2")
wS.Cells.ClearContents
With Worksheets("Sheet1")
.Range("A:A").AdvancedFilter Action:=xlFilterCopy, copytorange:=wS.Range("A1"), unique:=True
lastRow = wS.Cells(Rows.Count, "A").End(xlUp).Row
With Range(wS.Cells(2, "B"), wS.Cells(lastRow, "B"))
.Formula = "=SUMIF(Sheet1!A:A,A2,Sheet1!B:B)"
.Value = .Value
End With
End With
End Sub

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

こんばんは!

A列のA~Gさんは複数存在しているのでしょうか?
そうであればSUMIF関数で対応できると思いますが、VBAをお望みだというコトですので
一例です。

元データはSheet1にあり、Sheet2に表示するとします。
尚、Sheet1の1行目は項目行でデータは2行目以降にあるという前提です。
標準モジュールにしてください。

Sub Sample1()
Dim lastRow As Long, wS As Worksheet
Set wS = Worksheets("Sheet2")
wS.Cells.ClearContents
With Worksheets("Sheet1")
.Range("A:A...続きを読む

Qエクセル2007でプルダウンで選んだものに反応

Excel2007でプルダウンで選んだものに反応して隣のセルが自動入力される方法(エクセル2007)
A1をプルダウンで「猫」「犬」から選べるようにし、「猫」を選んだ場合B1に自動に「111」が、「犬」を選んだ場合B1に自動に「222」と入力されるようにしたいです。
ご教授の程、宜しくお願いします。

Aベストアンサー

VLOOKUP関数での方法です。
(1)別シートに入力文字列と対応コード表を作成。(仮にSheet2のA:B列範囲で順不同)
(2)B1に=IF(COUNTIF(Sheet2!A:A,A1),VLOOKUP(A1,Sheet2!A:B,2FALSE),"")を設定
   入力文字列が存在しない場合は空白としています。

QエクセルVBA 複数列のリストボックス内を検索して値を複数列表示したい

複数列表示したリストボックス内を絞り込み検索して絞り込み値も検索前と同様の複数列で表示することはできますか?

現場一覧シートのA列に現場名、K列に住所があります。(現場名は増え続けます)
別シートのセルをダブルクリックするとリストボックスを出します。(コード添付なし)
リストボックス内の絞り込み検索後に現場名をダブルクリックすると、アクティブセルに現場名と右隣に住所を表示するようにしたいです。
AddItemの複数列表示の使い方がよく理解できてない気がします。
添付写真は現場名30で絞り込み検索していますが住所列が表示されていません。絞り込み検索後に現場名と住所を表示する方法が分からずに困っております。

もし、リストボックスに複数列表示しなくても現場名ダブルクリック後にアクティブセルに現場名表示、連動して右隣セルに住所を表示が可能であればそれでも解決となります。

VBAをネットで勉強して3ヵ月たちます。
ネット上のコードを参考にして何とか他のブックは仕事で使えるVBAを組み立てましたが、これだけは記述方法が分かりません。
どうかご教授ください。

'*****************************************************
'検索フォームを開いた時の処理
'*****************************************************
Private Sub UserForm_Initialize()
Dim wLastGyou As Long

'最終行番号を取得
wLastGyou = Worksheets("現場一覧").UsedRange.Rows.Count

'リストボックスに「現場一覧」のリストをセット
With lstGenba

'列の指定:11列とする
.ColumnCount = 11

'列幅11列を2列表示にする
.ColumnWidths = "130;0;0;0;0;0;0;0;0;0;100"

'見出しの設定:無し
.ColumnHeads = False

'リストボックスの値にセルA2からK最終行までセット
.RowSource = "現場一覧!A2:k" & wLastGyou

End With

End Sub
'*****************************************************
'検索用のテキストボックス更新後の処理
'*****************************************************
Private Sub txbSerch_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
Dim Obj As Object
Dim wAddST As Variant
Dim wAddress As Variant
Dim wKamoku As Variant
Dim wLastGyou As Long

'最終行番号を取得
wLastGyou = Worksheets("現場一覧").UsedRange.Rows.Count

With Worksheets("現場一覧")

'テキストボックスの値が含まれるセルを検索
Set Obj = Range("現場一覧!A2:K" & wLastGyou).Find( _
What:=txbSerch.Value, _
LookIn:=xlValues, _
lookat:=xlPart, _
MatchByte:=False)

'検索対象がない場合はメッセージを表示
If Obj Is Nothing Then
MsgBox "現場名は存在しません。", _
vbOKOnly + vbInformation, "検索"
Else
'リストボックスをクリア
lstGenba.RowSource = ""

'検索にヒットした先頭のセルのアドレスをセット
wAddST = Obj.Address

'検索の繰り返し処理
Do
'検索にヒットしたセルのアドレスをセット
wAddress = Obj.Address

'検索にヒットしたセルの値を取得
wKamoku = .Range(wAddress).Value

'リストボックスに追加
lstGenba.AddItem wKamoku

'次の検索を行う
Set Obj = Range("現場一覧!A2:A" & wLastGyou).FindNext(Obj)

'最初にヒットしたアドレスと同じ場合は処理を終了
If Obj.Address = wAddST Then Exit Do
Loop
End If
End With
End Sub

'*****************************************************
'リストボックスをダブルクリックした時の処理
'*****************************************************
Private Sub lstGenba_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Dim wSheetName As Variant

'アクティブなシート名を取得
wSheetName = ActiveSheet.Name

'アクティブなセルにリストボックスの値をセット
With Worksheets(wSheetName)
.Cells(ActiveCell.Row, ActiveCell.Column).Value = lstGenba.List(lstGenba.ListIndex, 0)
.ActiveCell.Offset(0, 1).Value = lstGenba.List(lstGenba.ListIndex, 10)
End With
'フォームを終了する
Unload Me
End Sub

複数列表示したリストボックス内を絞り込み検索して絞り込み値も検索前と同様の複数列で表示することはできますか?

現場一覧シートのA列に現場名、K列に住所があります。(現場名は増え続けます)
別シートのセルをダブルクリックするとリストボックスを出します。(コード添付なし)
リストボックス内の絞り込み検索後に現場名をダブルクリックすると、アクティブセルに現場名と右隣に住所を表示するようにしたいです。
AddItemの複数列表示の使い方がよく理解できてない気がします。
添付写真は現場名30...続きを読む

Aベストアンサー

一例です。

'*****************************************************
'検索用のテキストボックス更新後の処理
'*****************************************************
Private Sub txbSerch_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
Dim Obj As Object
Dim wAddST As Variant
Dim wAddress As Variant
Dim wKamoku As Variant
Dim wLastGyou As Long

'---追加箇所--------------------------------------
Dim i As Long
'リスト表示11項目→3項目(現場名、空白、住所1)
lstGenba.ColumnCount = 3
lstGenba.ColumnWidths = "130;10;100"
'--------------------------------------------------

'最終行番号を取得
wLastGyou = Worksheets("現場一覧").UsedRange.Rows.Count

With Worksheets("現場一覧")

'テキストボックスの値が含まれるセルを検索
Set Obj = Range("現場一覧!A2:K" & wLastGyou).Find( _
What:=txbSerch.Value, _
LookIn:=xlValues, _
lookat:=xlPart, _
MatchByte:=False)

'検索対象がない場合はメッセージを表示
If Obj Is Nothing Then
MsgBox "現場名は存在しません。", _
vbOKOnly + vbInformation, "検索"
Else
'リストボックスをクリア
lstGenba.RowSource = ""

'検索にヒットした先頭のセルのアドレスをセット
wAddST = Obj.Address

'検索の繰り返し処理
Do
'検索にヒットしたセルのアドレスをセット
wAddress = Obj.Address

'--------変更箇所---------------------------------------
i = Obj.Row
'検索にヒットしたセルの値を取得とリストボックスに追加
lstGenba.AddItem .Cells(i, 1)
lstGenba.List(lstGenba.ListCount - 1, 1) = ""
lstGenba.List(lstGenba.ListCount - 1, 2) = .Cells(i, 11)
'--------------------------------------------------------

''検索にヒットしたセルの値を取得
'wKamoku = .Range(wAddress).Value
'
''リストボックスに追加
'lstGenba.AddItem wKamoku

'次の検索を行う
Set Obj = Range("現場一覧!A2:A" & wLastGyou).FindNext(Obj)

'最初にヒットしたアドレスと同じ場合は処理を終了
If Obj.Address = wAddST Then Exit Do
Loop
End If
End With
End Sub

'*****************************************************
'リストボックスをダブルクリックした時の処理
'*****************************************************
Private Sub lstGenba_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Dim wSheetName As Variant

'アクティブなシート名を取得
wSheetName = ActiveSheet.Name

'--------------変更箇所-----------------------------------------------
'アクティブなセルにリストボックスの値をセット
With Worksheets(wSheetName)
.Cells(ActiveCell.Row, ActiveCell.Column).Value = lstGenba.List(lstGenba.ListIndex, 0)
.Cells(ActiveCell.Row, ActiveCell.Column + 1).Value = lstGenba.List(lstGenba.ListIndex, 2)
End With
'--------------------------------------------------------------------------

'アクティブなセルにリストボックスの値をセット
'With Worksheets(wSheetName)
'.Cells(ActiveCell.Row, ActiveCell.Column).Value = lstGenba.List(lstGenba.ListIndex, 0)
'.ActiveCell.Offset(0, 1).Value = lstGenba.List(lstGenba.ListIndex, 10)
'End With
'フォームを終了する
Unload Me
End Sub

一例です。

'*****************************************************
'検索用のテキストボックス更新後の処理
'*****************************************************
Private Sub txbSerch_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
Dim Obj As Object
Dim wAddST As Variant
Dim wAddress As Variant
Dim wKamoku As Variant
Dim wLastGyou As Long

'---追加箇所--------------------------------------
Dim i As Long
'リスト表示11項目→3項目(現場名、空白、住所1)
lstG...続きを読む


人気Q&Aランキング

おすすめ情報