Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちらをご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

270 / 3841 ﾍﾟｰｼﾞ

←次へ　｜　前へ→


	【77037】Re:０の表示←訂正

BSESU - 15/5/9(土) 16:57 -


	引用なし

	パスワード

試してみました。

今のところ、願ったとおりの機能を発揮しています。

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

・ツリー全体表示


	【77036】Re:０の表示←訂正

BSESU - 15/5/9(土) 15:28 -


	引用なし

	パスワード

マナさん、御返答ありがとうございます。

試してみます。

後日、試した結果とともにあらためてお礼させていただきます。

・ツリー全体表示


	【77035】Re:０の表示←訂正

マナ - 15/5/9(土) 14:32 -


	引用なし

	パスワード

こんな感じで考えていました。
深く考えていませんので、問題ないか試してみてください。

Function ROUND2J(aa, nn) '数値を任意の有効桁数に四捨五入する
　　Dim k As Long

　　k = -Int(Application.Log(Abs(aa))) - 1 + nn

　　ROUND2J = ROUNDJ(aa, k)
　　If k > 0 Then
　　　　ROUND2J = Format(ROUND2J, "0." & String(k, "0"))
　　End If
End Function

・ツリー全体表示


	【77034】Re:０の表示←訂正

BSESU - 15/5/9(土) 14:15 -


	引用なし

	パスワード

0.1→0.100（.00を加える）

と書きましたが、

0.1→0.100（00を加える）

の間違いでした。

・ツリー全体表示


	【77033】Re:０の表示

BSESU - 15/5/9(土) 14:10 -


	引用なし

	パスワード

▼マナさん：
>▼BSESU さん：
>文字列にしてしまって良いということでようか？

ご返答、ありがとうございます。

結論から言えば、文字列でＯＫです。

計算などは、その最終表記するまでで済んでいます。
今回はあくまで、round2J()で指定されている有効数字の値を
見ため上、最終的に表示するためと考えています。

たとえば計算結果が、

計算結果が　　 1 のとき→表示は 1.00
　　　　　　　98　　 →　　　　 98.0
　　　　　　0.11　　 →　　　　 0.110
　　　　　　0.01　　 →　　　　 0.0100

みたいに見ため上、表示させるのが目的です

・ツリー全体表示


	【77032】Re:０の表示

マナ - 15/5/9(土) 13:34 -


	引用なし

	パスワード

▼BSESU さん：
文字列にしてしまって良いということでようか？

・ツリー全体表示


	【77031】０の表示

BSESU - 15/5/9(土) 12:03 -


	引用なし

	パスワード

有効数字が3のとき通常のエクセルは1、0.1となり0が省略され仕事柄、後ろの0も重要な意味をもつので、困っています。

例えば、　　　　　　　　　　　　　　　　　　　　

123→123　　　　　　　　　　　　　　　　　　　　
10→10.0(.0を加える）　　　　　　　　　　　　　　　　　　　　
0.1→0.100（.00を加える）

など最初の数字からゼロも含めて3つ表示させたいのです。　　　　　　　　　　　　　　　　　　　　
現在は、目視で手入力をしていますが、色々考え、下記のようなことも考えられるのかなと思ったのですが、表示したい数値が毎回桁が違うため、これらを合わせると膨大な式になってしまうのでマクロで解決できないかと思い、相談させていただきました。

※見づらくて大変申し訳ありません

条件　　　　　　sample　　　 round2j　　Len()　　　　最終表示　　
100>=x　　　　　123　　　　　123　　　　　-　　　　　123
→ROUND2J(B2,3)
　　　　　

100>x>=10　　　 99　　　　　 99　　　　　2　　　　　99.0
　　　　　　　　11.111　　　 11.1 　　　　4　　　　　11.1
　　　　　　　　99.99　　　　100　　　　　3　　　　　100　　　　
→IF(100>ROUND2J(B3,3)>=10,IF(D3=2,ROUND2J(B3,3)&".0",ROUND2J(B3,3)))

10>x>=1　　　　 3.1123　　　3.11 　　　　4　　　　　3.11
　　　　　　　　 1.1　　　　 1.1　　　　　3　　　　　1.10　　　　
　　　　　　　　9.9999　　　10　　　　　2　　　　　10.0　　　　
　　　　　　　　1　　　　　 1　　　　　　1　　　　　1.00　　　　
→IF(10>ROUND2J(B6,3)>=1,IF(D6=1,ROUND2J(B6,3)&".00",IF(D6=2,ROUND2J(B6,3)&".0",IF(D6=3,ROUND2J(B6,3)&"0",ROUND2J(B6,3)))))

1>x>=0.1　　　　0.9999　　　1　　　　　 1　　　　　1.00
　　　　　　　　 0.654　　　 0.654　　　　5　　　　　0.654　　　　
　　　　　　　　0.49　　　　0.49　　　　4　　　　　0.490　　　　
　　　　　　　　0.1　　　　 0.1　　　　　3　　　　　0.100　　　　
→IF(1>ROUND2J(B10,3)>=0.1,IF(D10=1,ROUND2J(B10,3)&".00",IF(D10=3,ROUND2J(B10,3)&"00",IF(D10=4,ROUND2J(B10,3)&"0",ROUND2J(B10,3)))))

0.1>x>=0.01　　0.099999　　0.1　　　　　3　　　　　0.100
　　　　　　　　 0.094444　　0.0944 　　　6　　　　　0.0944　　　　
　　　　　　　　0.01　　　　0.01 　　　　4　　　　　0.0100　　　　
　　　　　　　　0.011　　　 0.011　　　　5　　　　　0.0110　　　　
→IF(0.1>ROUND2J(B14,3)>=0.01,IF(D14=3,ROUND2J(B14,3)&"00",IF(D14=4,ROUND2J(B14,3)&"00",IF(D14=5,ROUND2J(B14,3)&"0",ROUND2J(B14,3)))))

0.01>x>=0.001　 0.009999　　0.01 　　　　4　　　　　0.0100
　　　　　　　　0.00944 　　0.00944　　　7　　　　　0.00944　　　　
　　　　　　　　0.001　　　 0.001　　　　5　　　　　0.00100　　　　
　　　　　　　　0.0011　　　0.0011 　　　6　　　　　0.00110　　　　
→IF(0.01>ROUND2J(B18,3)>=0.001,IF(D18=4,ROUND2J(B18,3)&"00",IF(D18=5,ROUND2J(B18,3)&"00",IF(D18=6,ROUND2J(B18,3)&"0",ROUND2J(B18,3)))))

0.001>x>=0.0001 0.00099999　0.001　　　　5　　　　　0.00100
　　　　　　　　0.000944　　0.000944 　　8　　　　　0.000944　　　　
　　　　　　　　0.0001　　　0.0001　　　6　　　　　0.000100　　　　
　　　　　　　　0.00011　　 0.00011　　　7　　　　　0.000110
→IF(0.01>ROUND2J(B22,3)>=0.001,IF(D22=5,ROUND2J(B22,3)&"00",IF(D22=6,ROUND2J(B22,3)&"00",IF(D22=7,ROUND2J(B22,3)&"0",ROUND2J(B22,3)))))

0.0001>x>=0.00001 0.000099999 0.0001 　　6　　　　　0.000100
　　　　　　　　　0.0000944　 0.0000944　9　　　　　0.0000944　　　　
　　　　　　　　　0.00001　　 0.00001　　7　　　　　0.0000100　　　　
　　　　　　　　　0.000011　　0.000011　 8　　　　　0.0000110
→IF(0.01>ROUND2J(B26,3)>=0.001,IF(D26=6,ROUND2J(B26,3)&"00",IF(D26=7,ROUND2J(B26,3)&"00",IF(D26=8,ROUND2J(B26,3)&"0",ROUND2J(B26,3)))))
　　　　

ちなみにROUND2J()は下記のような関数になっています

Function ROUNDJ(aa, nn) '数値を丸めて指定した桁数にする
　　ROUNDJ = Application.Round(aa, nn)
　　If CCur(Abs(ROUNDJ - aa) * 10 ^ (nn + 1)) = 5 And Application.RoundDown(aa, nn) * 10 ^ nn Mod 2 = 0 Then _
　　ROUNDJ = Application.RoundDown(aa, nn)
End Function
Function ROUND2J(aa, nn) '数値を任意の有効桁数に四捨五入する
　　ROUND2J = ROUNDJ(aa, -Int(Application.Log(Abs(aa))) - 1 + nn)

・ツリー全体表示


	【77030】Re:条件を満たす値の検索

kanabun - 15/5/8(金) 9:08 -


	引用なし

	パスワード

▼さくらさん： >A列に様々な数値が入力されています。 >その数値の中から、１０．０１以上１０．０５以下の数値のみを、 > A1セルから列方向に順に検索→データ取得し、同一ファイルのsheet2の > A1セルから列方向に出力させたいのですが。「列方向」というのは「行方向」（たて方向）のまちがいだとして、思うんですけど、A列の数値だけ書き出しても、意味ないのでは？ B列、C列...つまり、表の他の項目もいっしょに書き出さないと実用的な結果にならない気がします。ということで、 Sheet1 の表を A列の数値がある条件の行だけすべての列を転記するマクロはさきほどのを少し修正して、以下のようになります。 Sub tryA() 　　With Sheets("Sheet2") 　　　　.UsedRange.ClearContents 　　　　'条件をシートに書き出す　　　　.Range("Z1:AA1").Formula = "=Sheet1!$A$1" 　　　　.Range("Z2").Formula = ">=10.01" 　　　　.Range("AA2").Formula = "<=10.05" 　　　　　　　　'フィルターAdvancedFilter 実行　　　　Sheets("Sheet1").Range("A1").CurrentRegion.AdvancedFilter _ 　　　　　　Action:=xlFilterCopy, _ 　　　　　　CriteriaRange:=.Range("Z1:AA2"), _ 　　　　　　CopyToRange:=.Range("A1") 　　　　.Activate 　　End With End Sub

・ツリー全体表示


	【77029】Re:条件を満たす値の検索

β - 15/5/8(金) 8:25 -


	引用なし

	パスワード

▼kanabun さん：

>フィルタオプションというと、いつも思うんですけど...
>いまでもこの訳語は有効なんだろうか、と。
>Excel2007からはじめた人でも、どこかにフィルタオプションって用語が
>出てくるんでしょうか？
>

そうですねぇ。
個人的には、フィルターオプションという響きがすきで、愛着もあるんですが
新しい人からみれば、なんのこっちゃ？　でしょうね。

フィルター詳細設定　という表記を使うように気を付けます。
（アドバンストフィルター　という言葉もだめでしょうねぇ。ちょっと寂しい？）

・ツリー全体表示


	【77028】Re:条件を満たす値の検索

kanabun - 15/5/8(金) 8:19 -


	引用なし

	パスワード

▼β さん： > フィルターオプション案フィルタオプションというと、いつも思うんですけど... いまでもこの訳語は有効なんだろうか、と。 Excel2007からはじめた人でも、どこかにフィルタオプションって用語が出てくるんでしょうか？ # ひとりごとです、ごめんなさい。

・ツリー全体表示


	【77027】Re:条件を満たす値の検索

β - 15/5/8(金) 8:00 -


	引用なし

	パスワード

▼さくらさん：

kanabunさんからフィルターオプション案がでていますので、もう１つのオートフィルターで。
（１行目にタイトルがあるという前提ですが）

フィルターを掛け、抽出したものをコピペする操作をマクロ記録しますと

Sub Macro1()
'
' Macro1 Macro
'

'
　　ActiveSheet.Range("$A$1:$A$13").AutoFilter Field:=1, Criteria1:=">=10.1", _
　　　　Operator:=xlAnd, Criteria2:="<=10.5"
　　Columns("A:A").Select
　　Selection.Copy
　　Sheets("Sheet2").Select
　　ActiveSheet.Paste

End Sub

これを整理すると

Sub Test()
　　ActiveSheet.AutoFilterMode = False
　　Columns("A").AutoFilter Field:=1, Criteria1:=">=10.1", _
　　　　　　　　　　　　　　Operator:=xlAnd, Criteria2:="<=10.5"
　　With ActiveSheet.AutoFilter.Range
　　　　If .SpecialCells(xlCellTypeVisible).Count > 0 Then
　　　　　　.Copy Sheets("Sheet2").Range("A1")
　　　　End If
　　End With
　　ActiveSheet.AutoFilterMode = False
End Sub

・ツリー全体表示


	【77026】Re:条件を満たす値の検索

kanabun - 15/5/7(木) 22:24 -


	引用なし

	パスワード

ことばで説明すると難しいので、マクロ記録してみました（以下はそれをまとめたものです） Sub Macro1() ' Macro recorded 2015/5/7 by kanabun ' 　　Sheets("Sheet2").Select 　　Range("Z1:AA1").FormulaR1C1 = "=Sheet1!R1C1"　'条件書き込み　　Range("Z2").FormulaR1C1 = ">=10.01" 　　Range("AA2").FormulaR1C1 = "<=10.05" 　　　　'詳細設定(AdvancedFilter) 実行　　Sheets("Sheet1").Range("A1:A100").AdvancedFilter Action:=xlFilterCopy, _ 　　　　CriteriaRange:=Range("Z1:AA2"), CopyToRange:=Range("A1") End Sub

・ツリー全体表示


	【77025】Re:条件を満たす値の検索

kanabun - 15/5/7(木) 22:14 -


	引用なし

	パスワード

▼さくらさん： >A列に様々な数値が入力されています。 >その数値の中から、１０．０１以上１０．０５以下の数値のみを、 >sheet2のA1セルから列方向に出力させたいのですが。 > Findメソッドと比較演算子を組み合わせていろいろ試しましたがうまくいきません。ある範囲の数値の抽出転記ですから、これは、 Findメソッドよりフィルターの処理かと思います。 Sheet2 シートの空いているところに（たとえばそれが Z列だとすると）　Z1とAA1 に A列の見出し、　Z2に >=10.01 　AA2 に <=10.05 と書き込んで、フィルタオプション（2007以降だとフィルター - 詳細設定）を実行してみてください。マクロにするにはそれをマクロ記録します。

・ツリー全体表示


	【77024】条件を満たす値の検索

さくら - 15/5/7(木) 21:52 -


	引用なし

	パスワード

お世話になります。
以下のような動作をさせたいのですが、なかなかうまくいきません。
A列に様々な数値が入力されています。
その数値の中から、１０．０１以上１０．０５以下の数値のみを、A1セルから列方向に順に検索→データ取得し、同一ファイルのsheet2のA1セルから列方向に出力させたいのですが。Findメソッドと比較演算子を組み合わせていろいろ試しましたがうまくいきません。
ご教授頂けると幸いです。

・ツリー全体表示


	【77023】Re:コンボボックスとチェックボックスの...

mohimohi - 15/5/6(水) 22:17 -


	引用なし

	パスワード

▼β さん：
お世話になっております。
お返事遅くなってしまい、大変申し訳ございません。
そして、こんなにも御丁寧なお返事、本当に本当に感謝しています。
現在ちゃんと見れない状況ですので、週末改めてご連絡させていただきます。
その際、ご指導いただくことがあるかもしれませんが、よろしくお願い致します。
ありがとうございます。

・ツリー全体表示


	【77022】Re:コンボボックスとチェックボックスの...

β - 15/5/6(水) 21:56 -


	引用なし

	パスワード

▼mohimohi さん：

アップしたコードでは、項目名をコンスタントでチェック（祖父とか父とか）し
かつ、祖父なら CheckBox●　と決めつけしています。
実際にはこれでいいのかもしれませんが、Ｅ列からＩ列に記入する項目名がかわれば
コードも変える必要がでてきます。
また、チェックボックスの数に増減があれば、コードを変更する必要がでてきます。

以下は、そのような時、コードを変えず、Ｅ列からＩ列に記入する項目名と
チェックボックスのキャプションを同じにしておけば、自動判定しますし、
チェックボックスの増減も任意です。

アップ済みコードと全く同じプロシジャもありますが、フルセット掲載します。

Option Explicit

Dim rfA As Range
Dim rfX As Range
Dim dic As Object

Private Sub CommandButton1_Click()
　　Dim WS As Worksheet
　　Dim x As Long
　　Dim ckb As OLEObject
　　
　　Set WS = Sheets("Sheet2")
　　ComboBox2.Clear
　　ComboBox3.Clear
　　ComboBox4.Clear
　　ComboBox1.Value = ""
　　ComboBox2.Value = ""
　　ComboBox3.Value = ""
　　ComboBox4.Value = ""
　　
　　WS.UsedRange.Clear
　　WS.AutoFilterMode = False
　　Range("A1").CurrentRegion.Columns("A:D").Copy WS.Range("A1")
　　WS.Range("E1").Value = 1
　　WS.Range("A1").CurrentRegion.Columns("E").DataSeries Rowcol:=xlColumns, Type:=xlLinear, Date:=xlDay, Step:=1, Trend:=False
　　WS.Range("A1").AutoFilter
　　Set rfA = WS.AutoFilter.Range
　　Set rfX = WS.Cells(rfA.Rows.Count + 2, "A")
　　WS.Range("A1").CurrentRegion.Columns("A").Copy WS.Range("G1")
　　WS.Range("G1").CurrentRegion.RemoveDuplicates Columns:=1, Header:=xlYes
　　With WS.Range("G1").CurrentRegion
　　　　ComboBox1.List = .Offset(1).Resize(.Count - 1).Value
　　End With
　　　　For x = 1 To 8
　　　　OLEObjects("CheckBox" & x).Object.Value = False
　　　　OLEObjects("CheckBox" & x).Object.Enabled = False
　　Next

　　If dic Is Nothing Then
　　　　Set dic = CreateObject("Scripting.Dictionary")
　　　　For Each ckb In OLEObjects
　　　　　　If TypeName(ckb.Object) = "CheckBox" Then dic(ckb.Object.Caption) = ckb.Name
　　　　Next
　　End If
　　
End Sub

Private Sub ComboBox1_Change()

　　If ComboBox1.ListIndex < 0 Then Exit Sub
　　
　　ComboBox2.Clear
　　ComboBox3.Clear
　　ComboBox4.Clear
　　ComboBox2.Value = ""
　　ComboBox3.Value = ""
　　ComboBox4.Value = ""
　　
　　rfA.AutoFilter Field:=1, Criteria1:=ComboBox1.Value
　　If rfA.Columns(1).SpecialCells(xlCellTypeVisible).Cells.Count = 1 Then Exit Sub
　　rfX.CurrentRegion.Clear
　　Intersect(rfA, rfA.Offset(1)).Copy rfX
　　rfX.CurrentRegion.RemoveDuplicates Columns:=2, Header:=xlNo
　　With rfX.CurrentRegion.Columns("B")
　　　　ComboBox2.List = .Value
　　End With
　　
End Sub

Private Sub ComboBox2_Change()

　　If ComboBox2.ListIndex < 0 Then Exit Sub
　　
　　ComboBox3.Clear
　　ComboBox4.Clear
　　ComboBox3.Value = ""
　　ComboBox4.Value = ""
　　
　　rfA.AutoFilter Field:=1, Criteria1:=ComboBox1.Value
　　rfA.AutoFilter Field:=2, Criteria1:=ComboBox2.Value
　　If rfA.Columns(1).SpecialCells(xlCellTypeVisible).Cells.Count = 1 Then Exit Sub
　　rfX.CurrentRegion.Clear
　　Intersect(rfA, rfA.Offset(1)).Copy rfX
　　rfX.CurrentRegion.RemoveDuplicates Columns:=3, Header:=xlNo
　　With rfX.CurrentRegion.Columns("C")
　　　　ComboBox3.List = .Value
　　End With
　　
End Sub

Private Sub ComboBox3_Change()

　　If ComboBox3.ListIndex < 0 Then Exit Sub
　　
　　ComboBox4.Clear
　　ComboBox4.Value = ""
　　
　　rfA.AutoFilter Field:=1, Criteria1:=ComboBox1.Value
　　rfA.AutoFilter Field:=2, Criteria1:=ComboBox2.Value
　　rfA.AutoFilter Field:=3, Criteria1:=ComboBox3.Value
　　If rfA.Columns(1).SpecialCells(xlCellTypeVisible).Cells.Count = 1 Then Exit Sub
　　rfX.CurrentRegion.Clear
　　Intersect(rfA, rfA.Offset(1)).Copy rfX
　　With rfX.CurrentRegion.Columns("D:E")
　　　　ComboBox4.List = .Value
　　End With
　　
End Sub

Private Sub ComboBox4_Change()
　　Dim i As Long
　　Dim j As Long
　　Dim z As Long
　　Dim ckName As String
　　Dim k As Variant
　　
　　If ComboBox4.ListIndex < 0 Then Exit Sub
　　
　　For Each k In dic
　　　　With OLEObjects(dic(k)).Object
　　　　　　.Value = False
　　　　　　.Enabled = False
　　　　End With
　　Next
　　i = ComboBox4.List(ComboBox4.ListIndex, 1)
　　z = Cells(i, Columns.Count).End(xlToLeft).Column
　　For j = 5 To z
　　　　If dic.exists(Cells(i, j).Value) Then
　　　　　　With OLEObjects(dic(Cells(i, j).Value)).Object
　　　　　　　　.Value = True
　　　　　　　　.Enabled = True
　　　　　　End With
　　　　End If
　　Next
　　
End Sub

・ツリー全体表示


	【77021】Re:コンボボックスとチェックボックスの...

β - 15/5/6(水) 7:46 -


	引用なし

	パスワード

▼mohimohi さん：

一例として。
作業シートとして "Sheet2" を使います。
抽出そのものは、あオートフィルターや重複の削除といったエクセル標準機能を使っています。

書きなぐったので、同じような処理コードが何回も出てきます。
このあたりは整理して共通サブルーティン化もできるところでしょう。

Option Explicit

Dim rfA As Range
Dim rfX As Range

Private Sub CommandButton1_Click()
　　Dim WS As Worksheet
　　Dim x As Long
　　
　　Set WS = Sheets("Sheet2")
　　ComboBox2.Clear
　　ComboBox3.Clear
　　ComboBox4.Clear
　　ComboBox1.Value = ""
　　ComboBox2.Value = ""
　　ComboBox3.Value = ""
　　ComboBox4.Value = ""
　　
　　WS.UsedRange.Clear
　　WS.AutoFilterMode = False
　　Range("A1").CurrentRegion.Columns("A:D").Copy WS.Range("A1")
　　WS.Range("E1").Value = 1
　　WS.Range("A1").CurrentRegion.Columns("E").DataSeries Rowcol:=xlColumns, Type:=xlLinear, Date:=xlDay, Step:=1, Trend:=False
　　WS.Range("A1").AutoFilter
　　Set rfA = WS.AutoFilter.Range
　　Set rfX = WS.Cells(rfA.Rows.Count + 2, "A")
　　WS.Range("A1").CurrentRegion.Columns("A").Copy WS.Range("G1")
　　WS.Range("G1").CurrentRegion.RemoveDuplicates Columns:=1, Header:=xlYes
　　With WS.Range("G1").CurrentRegion
　　　　ComboBox1.List = .Offset(1).Resize(.Count - 1).Value
　　End With
　　　　For x = 1 To 8
　　　　OLEObjects("CheckBox" & x).Object.Value = False
　　　　OLEObjects("CheckBox" & x).Object.Enabled = False
　　Next

End Sub

Private Sub ComboBox1_Change()

　　If ComboBox1.ListIndex < 0 Then Exit Sub
　　
　　ComboBox2.Clear
　　ComboBox3.Clear
　　ComboBox4.Clear
　　ComboBox2.Value = ""
　　ComboBox3.Value = ""
　　ComboBox4.Value = ""
　　
　　rfA.AutoFilter Field:=1, Criteria1:=ComboBox1.Value
　　If rfA.Columns(1).SpecialCells(xlCellTypeVisible).Cells.Count = 1 Then Exit Sub
　　rfX.CurrentRegion.Clear
　　Intersect(rfA, rfA.Offset(1)).Copy rfX
　　rfX.CurrentRegion.RemoveDuplicates Columns:=2, Header:=xlNo
　　With rfX.CurrentRegion.Columns("B")
　　　　ComboBox2.List = .Value
　　End With
　　
End Sub

Private Sub ComboBox2_Change()

　　If ComboBox2.ListIndex < 0 Then Exit Sub
　　
　　ComboBox3.Clear
　　ComboBox4.Clear
　　ComboBox3.Value = ""
　　ComboBox4.Value = ""
　　
　　rfA.AutoFilter Field:=1, Criteria1:=ComboBox1.Value
　　rfA.AutoFilter Field:=2, Criteria1:=ComboBox2.Value
　　If rfA.Columns(1).SpecialCells(xlCellTypeVisible).Cells.Count = 1 Then Exit Sub
　　rfX.CurrentRegion.Clear
　　Intersect(rfA, rfA.Offset(1)).Copy rfX
　　rfX.CurrentRegion.RemoveDuplicates Columns:=3, Header:=xlNo
　　With rfX.CurrentRegion.Columns("C")
　　　　ComboBox3.List = .Value
　　End With
　　
End Sub

Private Sub ComboBox3_Change()

　　If ComboBox3.ListIndex < 0 Then Exit Sub
　　
　　ComboBox4.Clear
　　ComboBox4.Value = ""
　　
　　rfA.AutoFilter Field:=1, Criteria1:=ComboBox1.Value
　　rfA.AutoFilter Field:=2, Criteria1:=ComboBox2.Value
　　rfA.AutoFilter Field:=3, Criteria1:=ComboBox3.Value
　　If rfA.Columns(1).SpecialCells(xlCellTypeVisible).Cells.Count = 1 Then Exit Sub
　　rfX.CurrentRegion.Clear
　　Intersect(rfA, rfA.Offset(1)).Copy rfX
　　With rfX.CurrentRegion.Columns("D:E")
　　　　ComboBox4.List = .Value
　　End With
　　
End Sub

Private Sub ComboBox4_Change()
　　Dim i As Long
　　Dim j As Long
　　Dim z As Long
　　Dim x As Long
　　
　　If ComboBox4.ListIndex < 0 Then Exit Sub
　　
　　For x = 1 To 8
　　　　OLEObjects("CheckBox" & x).Object.Value = False
　　　　OLEObjects("CheckBox" & x).Object.Enabled = False
　　Next
　　i = ComboBox4.List(ComboBox4.ListIndex, 1)
　　z = Cells(i, Columns.Count).End(xlToLeft).Column
　　For j = 5 To z
　　　　x = 0
　　　　Select Case Cells(i, j).Value
　　　　　　Case "祖父"
　　　　　　　　x = 3
　　　　　　Case "祖母"
　　　　　　　　x = 4
　　　　　　Case "父"
　　　　　　　　x = 1
　　　　　　Case "母"
　　　　　　　　x = 2
　　　　　　Case "兄"
　　　　　　　　x = 5
　　　　　　Case "姉"
　　　　　　　　x = 6
　　　　　　Case "弟"
　　　　　　　　x = 7
　　　　　　Case "妹"
　　　　　　　　x = 8
　　　　End Select
　　　　
　　　　If x > 0 Then
　　　　　　OLEObjects("CheckBox" & x).Object.Value = True
　　　　　　OLEObjects("CheckBox" & x).Object.Enabled = True
　　　　End If
　　Next
　　
End Sub

・ツリー全体表示


	【77020】Re:コンボボックスとチェックボックスの...

mohimohi - 15/5/5(火) 21:46 -


	引用なし

	パスワード

▼β さん：
>ということは、Ａ，Ｂ，Ｃ，Ｄ列（ComboBox1,2,3,4　に対応）が同じものは存在しないということですか？
→存在しません。

>直接入力時のChangeイベントの扱い、これはすごく厄介ですよ。
>Styleプロパティで直接入力できないようにしてあれば心配はないですが、そうでなければ
>ListIndex をチェックする必要もでてきますね。
→正直、上記の内容はわからないので、調べて参考にさせていただきます。
つたない説明にも関わらず、丁寧にご指導いただき、本当にありがとうございます。希望のソースコードを組めないかもしれませんが、やってみます。

・ツリー全体表示


	【77019】Re:コンボボックスとチェックボックスの...

γ - 15/5/5(火) 20:59 -


	引用なし

	パスワード

▼mohimohi さん：
>>なお、私には、コンボボックスにする意味も
>>もっといえば、コントロールにする意義もよくわかりません。
>⇒正直例は、なんでもよかったのです。逆に混乱させてしまい、すみません。。。

いや、私は具体的な例が理解できないなどと申していない。
作ろうとしている機能が不明だと申し上げた。
混乱もしていない。

>コンボボックスを利用して条件を絞り、その中で、チェックボックスを条件に応じて自動でチェック可、不可に表示させたかったのです。
>食べ物の種類等で例に表したほうが良かったですね。。。申し訳ないです。
>　
>　a 　　 b 　　　 c 　　　　　　　　チェックボックス
>1肉　　　牛肉　　　松坂牛　　　　　　　　　ステーキ
>2果物　　いちご　　あまおう　　　　　　　　いちごみるく
>3果物　　マンゴー　太陽のマンゴー　　　　　マンゴーパフェ
>
>コンボボックスで、果物を選択→いちご、マンゴーの選択が表示される→いちごを選択→あまおうのみ表示→あまおうを選択(※この時、チェックボックスの押下可能はいちごみるくのみ)
>のようなことを伝えたかったのです。。。(涙)

まあ、あなたが考えるのをサポートしようと思っただけで。
コード作成の主体はあなたなので、私は別に困りもしません。
同情される覚えはありません。

私のコードは、別にコンボボックスとチェックボックスの連動なんか
していません。
各行単位のデータと、チェックボックスの連動はしていますがね。
コンボボックスなんぞ少しも出てきていないでしょ？

>>マクロの勉強材料ということなら、
>>まずインデントをしっかりつけることから始めてください。
>⇒お手数おかけして、申し訳ないです。感謝致します。

いや、こちらは何の関係もない。
ボタン一つで整形できるツールがあるので、
少しも手数は掛かっていない。

インデントがデタラメというのは、
言ってみれば、最高点100点のテストなり仕事で、
最初からマイナス100点のハンディを負っているというようなもので、
質問者さんのスキルが上がらないだけなので、誰も困りません。
インデントの重要性が理解できないようで、少し同情はするが。

・ツリー全体表示


	【77018】Re:コンボボックスとチェックボックスの...

β - 15/5/5(火) 20:19 -


	引用なし

	パスワード

▼mohimohi さん：

>複数選択は初めのうちに存在し、いくつか条件を絞っていくうちに、最終的には1つに絞れています。この1つに絞れた段階でチェックボックスに反映させたいです。

ということは、Ａ，Ｂ，Ｃ，Ｄ列（ComboBox1,2,3,4　に対応）が同じものは存在しないということですか？
もし、存在すれば、どうしますか？（そういうデータはつくらないということじゃなく、もしあれば）

まぁ、そういったことも考慮したとして、

・ComboBox1～ComboBox3 は重複を排除したリスト。
・ComboBox4 は重複しているものも、リストに含める。で、列数を２つにしておいて
　表示は１列のみ。隠れている２列目に行番号をセット。
・最終的にチェックボックスに反映させるのは ComboBox4が選ばれたとき。
　選ばれた行は、隠れている列の成功から判断。

こんな流れですかね。

それと、ComboBoxですから、初期値設定としては、直接入力も可能ですね。
直接入力時のChangeイベントの扱い、これはすごく厄介ですよ。
Styleプロパティで直接入力できないようにしてあれば心配はないですが、そうでなければ
ListIndex をチェックする必要もでてきますね。

・ツリー全体表示


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

270 / 3841 ﾍﾟｰｼﾞ

←次へ　｜　前へ→

ページ：

┃

記事番号：

(SS)C-BOARD v3.8 is Free