親子におすすめの新型プラネタリウムとは?

いろいろ拝見させていただいているのですが
理解が低いのが原因で困っています。



データのシートがあります。
・B列には、起点となる人の名前が記載(300名ほど)
・データの入っている列は、A:CE

データシートでB列にてオートフィルタをかけ
抽出シートに転記したい。

抽出シートでは、ユーザーフォームを組みました。
オプションボタン1 単一選択
オプションボタン2 複数選択
オプションボタン3 拡張選択
リストボックス(2・3に対して)
コマンドボタン   終了

とした場合、単一選択はできたのですが
複数選択の場合
該当数が「0」の表記となってしまい、うまくいきません。

同じような質問が…というお返事があることを承知でお伺いしています。
いただいた回答を基に、勉強をしていきたいと思っていますので
なにとぞよろしくお願い申し上げます。




Private Sub UserForm_Initialize()
ListBox1.ColumnCount = 1 'リストボックスの列は1
ListBox1.BoundColumn = 0 'ListIndexの値(行数)を使用する
ListBox1.MultiSelect = 0 '最初は単一選択状態にする
ListBox1.RowSource = 'リストのソース
ListBox1.ColumnHeads = True '列見出し表示
OptionButton1.Value = -1 'オプションボタン1を選択状態にする
End Sub

Private Sub OptionButton1_Click()
ListBox1.MultiSelect = fmMultiSelectSingle '単一選択状態にする
End Sub

Private Sub OptionButton2_Click()
ListBox1.MultiSelect = fmMultiSelectMulti '複数選択状態にする
End Sub

Private Sub OptionButton3_Click()
ListBox1.MultiSelect = fmMultiSelectExtended '拡張(連続)選択状態にする
End Sub

Private Sub ListBox1_Click() 'リストボックスがクリックされたとき(単一選択)

Dim 条件 As String

条件 = UserForm1.ListBox1.Text '氏名

With Worksheets("データ")
.Range("A1").AutoFilter _
field:=2, Criteria1:=条件

.Range("A1").CurrentRegion.SpecialCells(xlCellTypeVisible).Copy _
Worksheets("抽出").Range("A1")

.Range("A1").AutoFilter

End With

End Sub


Private Sub CommandButton1_Click() '選択終了ボタンがクリックされたとき(複数・拡張選択)

Dim 条件 As String
Dim lastRow As Long

With ListBox1
If .ListIndex = -1 Then Exit Sub '何も選択されていない

For 条件 = 0 To .ListCount - 1
If .Selected(条件) Then '行選択あり

With Worksheets("データ")
.Range("A1").AutoFilter _
field:=2, Criteria1:=条件

.Range("A1").CurrentRegion.SpecialCells(xlCellTypeVisible).Copy _
Worksheets("抽出").Range("A1")

.Range("A1").AutoFilter


End With

End If
Next
End With


End Sub

Private Sub UserForm_Deactivate()
Unload UserForm1 '×ボタンを押したら、ユーザーフォームのunloadをする
End Sub

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

A 回答 (2件)

フィルタして、コピー先が常にA1になっているからです。


「Range("A1").CurrentRegion.SpecialCells(xlCellTypeVisible).Copy _
Worksheets("抽出").Range("A1")」の部分

仮に、1番上の行が見出しなんだとすると、それを最初だけコピーするコードにしないといけません。


表のサイズが不明だったので、2列しかないと仮定しています。
Range("A1:B1")の部分のBはそちらの表に合わして、変更して下さい。


Private Sub CommandButton1_Click()
Dim 条件 As Integer
Dim lastRow As Long
With ListBox1
If .ListIndex = -1 Then Exit Sub '何も選択されていない

’◆
Worksheets("データ").Range("A1:B1").Copy Worksheets("抽出").Range("A1")
For 条件 = 0 To .ListCount - 1
If .Selected(条件) Then '行選択あり
With Worksheets("データ")
.Range("A1").AutoFilter _
field:=2, Criteria1:=ListBox1.List(条件)

’◆
.Range("A2:B" & .Range("A" & .Rows.Count).End(xlUp).Row).SpecialCells(xlCellTypeVisible).Copy _
Worksheets("抽出").Range("A" & Worksheets("抽出").Range("A" & Worksheets("抽出").Rows.Count).End(xlUp).Offset(1).Row)
.AutoFilterMode = False
End With
End If
Next
End With
End Sub


あと、リストのデータの反映の仕方が不明ですが、「RowSource 」にA1:B10とかセルを参照している場合は、オートフィルタの動作が不安定になるので、RowSource は空欄にして、以下の様にユーザーフォーム起動時に、値を代入して下さい。


Private Sub UserForm_Initialize()
Dim I As Integer
For I = 1 To Range("A" & Rows.Count).End(xlUp).Row
ListBox1.AddItem Range("A" & I).Value
Next I
End Sub
    • good
    • 0

変更すべき点は以下の★部分です。



Private Sub CommandButton1_Click()
Dim 条件 As Integer '★
Dim lastRow As Long

With ListBox1
If .ListIndex = -1 Then Exit Sub '何も選択されていない

For 条件 = 0 To .ListCount - 1
If .Selected(条件) Then '行選択あり
With Worksheets("データ")
.Range("A1").AutoFilter _
field:=2, Criteria1:=.List(条件) ’★

.Range("A1").CurrentRegion.SpecialCells(xlCellTypeVisible).Copy _
Worksheets("抽出").Range("A1")

.Range("A1").AutoFilter


End With

End If
Next
End With


End Sub
    • good
    • 0
この回答へのお礼

早速のご回答、ありがとうございました。

★のところを変更したのですが、オブジェクトはこのプロパティ及び…とエラーがでましたので

field:=2, Criteria1:= ListBox1.List(条件) 

で作業をしてみました。

そうすると、リストボックスで複数選択した中の一番下の名前だけに対して抽出がされてしまいます。
お教えいただいた中で、理解ができておらず申し訳ありません。

重ねてご教授いただけたらと思います。
よろしくお願い申し上げます。

なお、上記の中で
Dim lastRow As Long は消し忘れた内容でした。
失礼いたしました。

お礼日時:2013/03/12 15:31

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

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

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

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

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

Qexcelのリストボックスで選択した項目をアクティブセルに入力方法

もしかしたら既出かもしれませんが・・・
フォームコントロールのリストボックスで入力範囲の指定したリストをリンクするセルをワークシート上にクリックしたセルに入力させる方法はありますか?
もし、不可能でしたら、ActiveXコントロールのリストボックスでも構いません。よろしくお願いいたします。

Aベストアンサー

そのリストボックスの、コードの表示で
Private Sub ListBox1_Click()
ActiveCell = ListBox1.List(ListBox1.ListIndex)
End Sub
と入れるだけ。
コントロールツールボックスのコントロールを、ワークシートに直接
貼り付けた場合。
WEBや解説書で、ListboxとかListindexなど調べましたか。

Qexcel VBA リストボックス複数選択後の処理

どなたか教えてください。
Sheet1にユーザーフォームを使用しデータを入力しています。
リストボックスが複数選択した後にコマンドボタンをクリックした際、
選択項目を1行のセル[Cells(myRow, 16)~Cells(myRow, 20)]に左詰めで表示したい場合はどのようにするのでしょうか?

例:リストボックスには10項目あるとして、そのうち1行目、3行目、5行目だけが選択された場合のパターンで、1行目がCells(myRow, 16)、3行目がCells(myRow, 17)、5行目がCells(myRow, 18)に表示したいのですが・・・。 最大5項目選択とみています。
※コマンドボタンは他のTextBox等も含まれ、下記のような感じです。

Private Sub CommandButton1_Click()
Dim myRow As Long

Sheets("Sheet1").Select
myRow = Range("A65536").End(xlUp).Offset(1, 0).Row
'各テキストボックの値をセルに入力
Cells(myRow, 1).Value = TextBox1.Value
Cells(myRow, 2).Value = TextBox2.Value
Cells(myRow, 3).Value = ComboBox1.Value
Cells(myRow, 4).Value = TextBox3.Value
Cells(myRow, 5).Value = TextBox4.Value
.
.
.
Cells(myRow, 16).Value =
Cells(myRow, 17).Value =
Cells(myRow, 18).Value =
.
.
.
'セルに入力が各テキストボックの値をクリア
TextBox3.Value = ""
TextBox4.Value = ""
ComboBox2.Value = ""
ComboBox3.Value = ""
'フォーカスをTextBox3に移動
TextBox3.SetFocus

End Sub

どなたか教えてください。
Sheet1にユーザーフォームを使用しデータを入力しています。
リストボックスが複数選択した後にコマンドボタンをクリックした際、
選択項目を1行のセル[Cells(myRow, 16)~Cells(myRow, 20)]に左詰めで表示したい場合はどのようにするのでしょうか?

例:リストボックスには10項目あるとして、そのうち1行目、3行目、5行目だけが選択された場合のパターンで、1行目がCells(myRow, 16)、3行目がCells(myRow, 17)、5行目がCells(myRow, 18)に表示したいのですが・・・。 最大5...続きを読む

Aベストアンサー

以下がListBox1を複数選択して、セルに転記する部分です。

'--------------------------------------
 Dim N As Integer
 Dim Clm As Integer

 Clm = 15

'''セルへ転記

 For N = 0 To ListBox1.ListCount - 1
   If ListBox1.Selected(N) Then
     Clm = Clm + 1
     Cells(myRow, Clm) = ListBox1.List(N)
   End If
 Next N

'''ListBox1の選択状態の解除

 For N = 0 To ListBox1.ListCount - 1
   ListBox1.Selected(N) = False
 Next N
'-----------------------------------------------

言わずもがなのことですが、
ListBox1は複数選択可能になっていなければいけません。
ListBox1.MultiSelect = fmMultiSelectMulti
 

以下がListBox1を複数選択して、セルに転記する部分です。

'--------------------------------------
 Dim N As Integer
 Dim Clm As Integer

 Clm = 15

'''セルへ転記

 For N = 0 To ListBox1.ListCount - 1
   If ListBox1.Selected(N) Then
     Clm = Clm + 1
     Cells(myRow, Clm) = ListBox1.List(N)
   End If
 Next N

'''ListBox1の選択状態の解除

 For N = 0 To ListBox1.ListCount - 1
   ListBox1.Selected(N) = False
 Next N
'------------...続きを読む

QVBAのListBoxで複数選択してExcelの1つのセルに反映

いつもお世話になります。
出来るか教えて欲しいのですが、

UserFormに「ListBox」と「Commandbutton」があります。
「ListBox」には5つの選択肢がありますが、これを複数選択可に
して、「Commandbutton」をクリックすることにより、
Excelの1つのセルに「ListBox」で選択した項目を反映させることは
出来ますか?

出来る場合どのようにすれば宜しいでしょうか?

Aベストアンサー

ListBoxのSelectedプロパティを使えばどのアイテムが選択されているか確認出来ます

ボタンのクリックイベントで
dim n as integer, s as string
for n = 0 to ListBox1.Count-1
  if ListBox1.Selected( n ) then
    s = s & ListBox1.List( n )
  end if
Next
Range("A2").value = s
といった具合で出来るかと思います

Qexcelで左のセル項目にあわせた複数選択可能なプルダウンボックスを表

excelで左のセル項目にあわせた複数選択可能なプルダウンボックスを表示させたい。

添付のようなイメージのものを作成したいと考えています。
B列はプルダウンで選べる様になっており、B列の内容により、C列の選択肢を変更
したいのです。
ちなみに、今C列はリストボックスになっていますが、チェックボックスなど、
リストから複数選べるようになれば問題ありません。

このようなものは、VBAなどを組まないとできないのでしょうか。

よろしくお願いいたします。

Aベストアンサー

値を利用することで考えていました。
リストボックスは選んだ表示だけで良くて、
あとはB列のリストボックスの変更に合わせて
リストボックスの項目が変われば良いということですね。

すると、一例としてはこんな感じでしょうか?
セルB2かセルB3の値変更があった場合、
セルの内容(例では魚屋、果物屋、八百屋)に応じて、
リストボックスの内容を変更するマクロです。
設定は下記の通りとしています。
・セルB2、B3はセルE7~E9のリスト選択
・セルB2またはB3の内容に合わせてセルE14~セルG16の
 データをリストに表示する
・2行目にあるリストボックスを“ListBox1”
 3行目にあるリストボックスを“ListBox2”としています。
・リストボックスのListFillRangeは空白にしておく。

以下をVBAで操作を行うシートに貼りつけてみてください。
Excel2002ですが、セルB2を変更すると、リストボックス1の表示内容が
セルB3を変更すると、リストボックス2の表示内容が変わります。
たた、表示内容が変わったときは何も選択していない状態になります。
シートの値を参照していますが、VBA内での記載でもできると思います。

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim MyRng As Range, isect As Range, i As Long

'セル変更箇所の確認
Set isect = Application.Intersect(Target, Range("B2:B3"))
If isect Is Nothing Then
Exit Sub
End If
'リストボックスの範囲設定
Select Case Target.Value
Case "魚屋"
Set MyRng = ActiveSheet.Range("F14:F16")
Case "八百屋"
Set MyRng = ActiveSheet.Range("E14:E16")
Case "果物屋"
Set MyRng = ActiveSheet.Range("G14:G16")
End Select
'リストボックスの設定
If isect.Address = Range("B2").Address Then
ListBox1.List = MyRng.Value
ElseIf isect.Address = Range("B3").Address Then
ListBox2.List = MyRng.Value
End If
End Sub

値を利用することで考えていました。
リストボックスは選んだ表示だけで良くて、
あとはB列のリストボックスの変更に合わせて
リストボックスの項目が変われば良いということですね。

すると、一例としてはこんな感じでしょうか?
セルB2かセルB3の値変更があった場合、
セルの内容(例では魚屋、果物屋、八百屋)に応じて、
リストボックスの内容を変更するマクロです。
設定は下記の通りとしています。
・セルB2、B3はセルE7~E9のリスト選択
・セルB2またはB3の内容に合わせてセルE14~セルG16の
...続きを読む

QExcelVBAのLISTBOXから複数行選択された項目を取得する方法

タイトルのとおりなのですが、
ListBoxで、MultiSelectのプロパティを設定後に、
実際の動作で選択された全ての項目を取得する方法を教えてください。

自分でも探してはおりますが、もしよろしければ
ご指導いただけますと幸いです。

くれぐれも、~を見れば分かるでしょ…などといった
中傷的なご返答はご遠慮願います。

よろしくお願いいたします。

Aベストアンサー

回答の簡単のために、ワークシートにリストボックスを1つ貼り付け
プロパティで-1 fmMultiSelectMulti を選ぶ。
ListFilRangeにセル範囲を設定しておく。(注)1行空白行をしておく。
回答の簡単のために、リストボックスの
DblClickイベント(注)に
Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Dim lItem As Long
For lItem = 0 To ListBox1.ListCount - 1
If ListBox1.Selected(lItem) = True Then
Sheet1.Range("A65536").End(xlUp).Offset(1, 0) = ListBox1.List(lItem)
ListBox1.Selected(lItem) = False
End If
Next
End Sub
これで複数選択し、リストボックスの余白行(注)をダブルクリックすると、A列に選択したものが、累積入力される。
(注)あまり自然な設例ではなかったと反省するが、上記コードの回答がメインなので、このままにします。

回答の簡単のために、ワークシートにリストボックスを1つ貼り付け
プロパティで-1 fmMultiSelectMulti を選ぶ。
ListFilRangeにセル範囲を設定しておく。(注)1行空白行をしておく。
回答の簡単のために、リストボックスの
DblClickイベント(注)に
Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Dim lItem As Long
For lItem = 0 To ListBox1.ListCount - 1
If ListBox1.Selected(lItem) = True Then
Sheet1.Range("A65536").End(xlUp).Offset(1, ...続きを読む

QエクセルVBAで複数選択できるように設定したリストボックスの、選択され

エクセルVBAで複数選択できるように設定したリストボックスの、選択されている項目の数を取得する方法はないでしょうか?

Aベストアンサー

For i= 0 To ListBox1.ListCount - 1 '
If ListBox1.Selected(1) Then
mSelectItem = mSelectItem + 1
End If
Next

こんな感じでいかがでしょう。

QVBA コンボボックスで選んだ値を取得するには

ユーザーフォーム上のコンボボックスから値を選択し、その値を変数として使いたいのですが、うまくいきません。

コンボボックスのコードで
Private Sub ComboBox1_Change()
moji1 = ComboBox1.Text
Range("A1").Value = moji1
のようにすれば、コンボボックスから値を選んだ時点でA1セルにその値をコピーできるのですが、同じユーザーフォーム上にあるコマンドボタンをクリックして実行する「マクロ1」にてこのmoji1という変数を使いたいのです。

マクロ1にて、上記と同じ
Range("A1").Value = moji1
というコードを記述しても、ユーザーフォームで選択した値が消えており、empty値となってしまいます。

原因をご存知の方はお教えください。

Aベストアンサー

原因については下記を参考にしてください。
http://pc.nikkeibp.co.jp/pc21/special/2007_gosa/eg5.shtml

QExcelマクロ:オートフィルタ3つ以上の条件

添付の画像を使って質問させて頂きます。
バージョンは2010です。

お客様名 A,B,C,D,E 以外のお客様名を抽出するようにマクロを組みたいのですが

ActiveSheet.Range("$A$1:$D$15").AutoFilter Field:=2, Criteria1:= _
"<"&">&"A", Operator:=xlOr, Criteria2:="<"&">&"B""

の様に考えましたが一つの列に3つ以上の条件では対応できないことが分かりました。

添付の画像は実際使用している表を簡素化しているため
お客様名が少ないですが、実際は多様なお客様名があります。

その中で特定した5社以外のお客様の情報を抽出したいです。

宜しくお願い致します。

Aベストアンサー

>特定した5社以外のお客様の情報を抽出したい

sub macro1()
 dim a
 a = application.transpose(range("B2:B" & range("B65536").end(xlup).row).value)

 a = filter(a, "A", false)
 a = filter(a, "B", false)
 a = filter(a, "C", false)
 a = filter(a, "D", false)
 a = filter(a, "E", false)

 range("A:D").autofilter field:=2, criteria1:=a, operator:=xlfiltervalues
end sub

とかでいいです。

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検索結果の指定列をリストボックスに反映したい

ユーザーフォームにTextbox、検索ボタン、Listboxを配置しました。
Textboxに「E列」の大分類(例:「35」)を入力して、検索ボタンを押すと、「35」のレコードのA列とB列だけListboxに反映させるようにしたいです。
皆さん、教えて下さい!宜しくお願いします。

 A列     B列    C列      D列    E列
商品コード/商品名/仕入先コード/仕入先名/大分類
123456 りんご 011 AAA 35
456789 ばなな 012 BBB 35
234567    テーブル  013 CCC 23

Aベストアンサー

元データはSheet1にあるとして

private sub CommandButton1_Click()
 dim r as long
 if me.textbox1 = "" then exit sub
 me.listbox1.clear
 me.listbox1.columncount = 2

 with worksheets("Sheet1")
 for r = 2 To .range("E65536").end(xlUp).row
  if cstr(.cells(r, "E").value) = me.textbox1.value then
   me.listbox1.additem .cells(r, "A").value
   me.listbox1.list(me.listbox1.listcount - 1, 1) = .cells(r, "B").value
  end if
 next r
 end with
end sub

ぐらいで,逐一追加していくのが一番簡単かと思います。


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

人気Q&Aランキング