Excel VBA質問箱 IV

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

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


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

6749 / 13644 ﾂﾘｰ

←次へ　｜　前へ→

▼

【43180】メッセージBoxの使い方？ 事務員 06/10/4(水) 22:28

【43181】Re:メッセージBoxの使い方？ かみちゃん 06/10/4(水) 22:42

【43187】Re:メッセージBoxの使い方？ 事務員 06/10/5(木) 10:34

【43192】Re:メッセージBoxの使い方？ Jaka 06/10/5(木) 13:36

【43209】Re:メッセージBoxの使い方？ 事務員 06/10/5(木) 20:56

【43213】Re:メッセージBoxの使い方？ ToShiYo 06/10/5(木) 22:44

【43237】Re:メッセージBoxの使い方？ 事務員 06/10/6(金) 16:28

【43246】Re:メッセージBoxの使い方？ ToShiYo 06/10/6(金) 19:14

【43249】Re:メッセージBoxの使い方？ 事務員 06/10/6(金) 21:29

【43251】Re:メッセージBoxの使い方？ ToShiYo 06/10/6(金) 21:56

【43252】Re:メッセージBoxの使い方？ ToShiYo 06/10/6(金) 22:08

【43214】Re:メッセージBoxの使い方？ ponpon 06/10/5(木) 23:56

【43238】Re:メッセージBoxの使い方？ 事務員 06/10/6(金) 16:37

【43239】Re:メッセージBoxの使い方？ Jaka 06/10/6(金) 17:17

【43250】Re:メッセージBoxの使い方？ ponpon 06/10/6(金) 21:50

【43306】Re:メッセージBoxの使い方？ 事務員 06/10/8(日) 20:16

【43311】Re:メッセージBoxの使い方？ ponpon 06/10/8(日) 21:44

【43379】Re:メッセージBoxの使い方？ 事務員 06/10/12(木) 12:36


	【43180】メッセージBoxの使い方？

事務員 - 06/10/4(水) 22:28 -


	引用なし

	パスワード

こんばんは

下記のコード、
Selection.AutoFilter Field:=1, Criteria1:="=10", Operator:=xlAndの条件付与
方式を変更したいですが、分からなくて、ご伝授下さい。
オートフィルタ条件を固定することではなく、対話方式に変更したいです。
イメージはマクロを実行すると、オートフィルタへの条件は画面上に設けて、
条件を入力し、その入力した条件をチェックして、
半角数字の桁数は6桁かどうか、半角６桁数字であれば、次へ
　　　　　　　　　　　　　　そうでない場合は、再度入力。
よろしくお願いします。
　
Sub Pbcl_30()
'コピー元のSheetＡを選択する
Sheets("SheetＡ").Select
Range("A1").Select
'オートフィルタを指定
Selection.AutoFilter
'A列をKeyにして、抽出条件＝10を与えてる
Selection.AutoFilter Field:=1, Criteria1:="=10", Operator:=xlAnd　
Cells.Select
'結果をコピーして
Selection.Copy
'SheetＢを指定し、貼り付ける
Sheets("SheetＢ").Select
Cells.Select
ActiveSheet.Paste
Sheets("SheetＡ").Select
Application.CutCopyMode = False
Selection.AutoFilter
Range("A1").Select
Sheets("SheetＢ").Select
Range("A1").Select
End Sub


	【43181】Re:メッセージBoxの使い方？

かみちゃん - 06/10/4(水) 22:42 -


	引用なし

	パスワード

こんにちは。かみちゃん　です。

>オートフィルタ条件を固定することではなく、対話方式に変更したいです。
>イメージはマクロを実行すると、オートフィルタへの条件は画面上に設けて、
>条件を入力し、

1.InputBoxを使って、条件を入力
2.セルに条件を入力
のいずれかでできます。

1.については、InputBoxのヘルプで調べるまたは、過去ログを参照してみてください。
http://www.moug.net/tech/exvba/0100032.htm
http://www.moug.net/tech/exvba/0150066.htm
http://www.officetanaka.net/excel/vba/tips/tips37.htm
http://www.sanynet.ne.jp/~awa/excelvba/kouza/chapt_03/004.html
なども参考にしてください。

2.については、
Selection.AutoFilter Field:=1, Criteria1:="=10", Operator:=xlAnd　
を
Selection.AutoFilter Field:=1, Criteria1:=Range("A1").Value, Operator:=xlAnd
のようにします。


	【43187】Re:メッセージBoxの使い方？

事務員 - 06/10/5(木) 10:34 -


	引用なし

	パスワード

かみちゃんさん
ありがとうございます。早速手直ししました。
AutoFilter Fieldの値に付与するところを、修正しましたが、何かコンパイル
エラー（InputBoxの修飾子が不正が出ています。
どこが間違っていますか？よろしくお願いします。

Sub Pbcl_30()
Sheets("SheetＡ").Select
Range("A1").Select
Selection.AutoFilter
Selection.AutoFilter Field:=1, _
　Criteria1:=InputBox(Prompt:="適当に文字や数値を入力してみてください", _
　　　Title:="Let's Excel VBA", _
　　 Default:="ここに入力します", _
　　　 XPos:=200, YPos:=100).Value, Operator:=xlAnd
Cells.Select
Selection.Copy
Sheets("SheetＢ").Select
Cells.Select
ActiveSheet.Paste
Sheets("SheetＡ").Select
Application.CutCopyMode = False
Selection.AutoFilter
Range("A1").Select
Sheets("SheetＢ").Select
Range("A1").Select
End Sub


	【43192】Re:メッセージBoxの使い方？

Jaka - 06/10/5(木) 13:36 -


	引用なし

	パスワード

こういう書き方を誰に教わったの？と聞く前に >Selection.AutoFilter Field:=1, _ >　Criteria1:=InputBox(Prompt:="適当に文字や数値を入力してみてください", _ >　　　Title:="Let's Excel VBA", _ >　　 Default:="ここに入力します", _ >　　　 XPos:=200, YPos:=100).Value, Operator:=xlAnd 　　　　　　　　　　　　　　　　↑ 　　　　　　　　　　なんで、こんなの(.Value)がついているのでしょうか？　　　　　　　　　　　　　ずれていたので修正１度、InputBoxの内容を変数に入れて、中身の判定をしないとエラーになりますよ。キャンセルされたり、空だったりとか考えないのでしょうか？また、オートフィルタに無いものだったりとか....。 InputBoxで検査すれば、使用例が見つかるんじゃないかと思います。因みに >Range("A1").Select >Selection.AutoFilter >Selection.AutoFilter Field:=1, 　↓ >Range("A1").AutoFilter Field:=1,


	【43209】Re:メッセージBoxの使い方？

事務員 - 06/10/5(木) 20:56 -


	引用なし

	パスワード

Jakaさん
　ご指導いただき、ありがとうございます。　
　修正しました、動作を確認しましたが、特に問題ありません。
ただ一点だけ、ご指摘したとおり、変数を入力したあと、変数に対しての
規則チェックをしたいですが、
たとえ、8桁の数字しか認められていないからです。
どの用にすれば、可能になるのでしょうか？
ご指示ください、よろしくお願いします。

省略
Application.ScreenUpdating = False
Sheets("SheetＡ").Select
Range("A1").AutoFilter Field:=1, _
　Criteria1:=InputBox(Prompt:="適当に文字や数値を入力してみてください", _
　　　Title:="Let's Excel VBA", _
　　　Default:="ここに入力します", _
　　　 XPos:=5800, YPos:=5400), Operator:=xlAnd
Cells.Select
Selection.Copy
Sheets("SheetＢ").Select
Cells.Select
ActiveSheet.Paste
Sheets("SheetＡ").Select
Application.CutCopyMode = False
Selection.AutoFilter
Range("A1").Select
Sheets("SheetＢ").Select
Range("A1").Select
Application.ScreenUpdating = True
End Sub


	【43213】Re:メッセージBoxの使い方？

ToShiYo - 06/10/5(木) 22:44 -


	引用なし

	パスワード

▼事務員さん：
　
>　修正しました、動作を確認しましたが、特に問題ありません。
>ただ一点だけ、ご指摘したとおり、変数を入力したあと、変数に対しての
>規則チェックをしたいですが、
>たとえ、8桁の数字しか認められていないからです。
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
↑の意味がちょっと分からないのですが？･･･
私なりに、一度コードを書いてみました。一度試してください。
シート名＝A,Bは半角英数で処理していますので、貴殿のシート名に合わせて
動かしてください。（エラー処理はしていません。）

Sub Auto_Fil_Copy ()
Sheets("SheetA").Activate
Range("A1").AutoFilter Field:=1, _
　Criteria1:=InputBox(Prompt:="適当に文字や数値を入力してみてください", _
　　　Title:="Let's Excel VBA", _
　　　Default:="ここに入力します", _
　　　 XPos:=5800, YPos:=5400), Operator:=xlAnd
　With Sheets("SheetB")
　　　 .Activate
　　　 .Cells.Clear
　　 Sheets("SheetA").Range("A1").CurrentRegion.Copy
　　　With .Range("A1")
　　　　　 .PasteSpecial 1
　　　　　 .Select
　　　End With
　End With
　 Application.CutCopyMode = False
End Sub


	【43214】Re:メッセージBoxの使い方？

ponpon - 06/10/5(木) 23:56 -


	引用なし

	パスワード

▼事務員さん：

>ただ一点だけ、ご指摘したとおり、変数を入力したあと、変数に対しての
>規則チェックをしたいですが、
>たとえ、8桁の数字しか認められていないからです。
>どの用にすれば、可能になるのでしょうか？
>ご指示ください、よろしくお願いします。

一番はじめの質問では、
>半角数字の桁数は6桁かどうか、半角６桁数字であれば、次へそうでない場合は、再度入力。
と、なってましたが、どちらが正しいのでしょう？

こういうことでしょうか？
InputBoxの返り値を変数retで受けて判断しています。

Sub test()
　　Dim ret
　
　　Application.ScreenUpdating = True
　　Do
　　　ret = Application.InputBox(Prompt:="適当に文字や数値を入力してみてください", _
　　　　　　Title:="Let's Excel VBA", Default:="ここに入力します", Type:=1)
　　Loop Until Len(ret) = 8　'ここに桁数を指定してください
　　
　　Sheets("SheetＢ").Cells.ClearContents
　　With Sheets("SheetＡ")
　　　　.Range("A1").AutoFilter Field:=1, Criteria1:=ret, Operator:=xlAnd
　　　　If .Range("A:A").SpecialCells(xlCellTypeVisible).Rows.Count = 1 Then
　　　　　 MsgBox "該当する数字はありません"
　　　　　 .Range("A1").AutoFilter
　　　　　 Exit Sub
　　　　Else
　　　　　 .AutoFilter.Range.Copy Sheets("SheetＢ").Range("A1")
　　　　End If
　　　　.Range("A1").AutoFilter
　　End With
　　Application.ScreenUpdating = True
End Sub


	【43237】Re:メッセージBoxの使い方？

事務員 - 06/10/6(金) 16:28 -


	引用なし

	パスワード

ToShiYoさん
ありがとうございます。

>>たとえ、8桁の数字しか認められていないからです。
>~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
>↑の意味がちょっと分からないのですが？･･･
変数として、8桁（年月日：20001231）数字であれば、認められますが、
年月日でないデータなら、再度入力ようにしたいです。

いただいたコードを使って、動かしてみましたが、その結果は以下の通り、

年月日
20060901
20060901
20060902
の場合は、
「20060901」を入力したら、正しい結果が戻ってきます。
「20060902」を入力したら、結果がでません。


	【43238】Re:メッセージBoxの使い方？

事務員 - 06/10/6(金) 16:37 -


	引用なし

	パスワード

ponponさん
ありがとうございます。

年月日を入力して、その条件に合うレコードを抽出し、SheetBへコピーします。
※年月日は8桁数字（年月日：20001231)
そちらのコードで動いてみたら、以下の結果になりました。

年月日
20060901
20060901
20060902
・
「20060901」を入力したら、正しい結果がでました。
「20060902」を入力したら、結果はでません。

その原因はなんでしょうか？


	【43239】Re:メッセージBoxの使い方？

Jaka - 06/10/6(金) 17:17 -


	引用なし

	パスワード

原因がわかってませんけど、こっちのが良くないですか？
短くてすみません。

　　 If .Range("A:A").SpecialCells(xlCellTypeVisible).Rows.Count = 1 Then
　　　　　　　　　　↓
　　 If .AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Count = 1 Then


	【43246】Re:メッセージBoxの使い方？

ToShiYo - 06/10/6(金) 19:14 -


	引用なし

	パスワード

▼事務員さん：
>年月日
>20060901
>20060901
>20060902
>の場合は、
>「20060901」を入力したら、正しい結果が戻ってきます。
>「20060902」を入力したら、結果がでません。

これでもう一度試してみてください。
20060902もOKです。また20061012などもOKです。

Sub Auti_Fil_Copy()

Sheets("SheetA").Activate
　Range("A1").AutoFilter Field:=1, _
　　Criteria1:=InputBox(Prompt:="適当に文字や数値を入力してみてください", _
　　　Title:="Let's Excel VBA", _
　　　　Default:="ここに入力します", _
　　　　　XPos:=5800, YPos:=5400)
　With Sheets("SheetB")
　　　 .Activate
　　　 .Cells.Clear
　Sheets("SheetA").Range("A6").CurrentRegion.Copy
　　 With .Range("A6")
　　　　　.PasteSpecial 1
　　　　　.Select
　　 End With
　Sheets("SheetA").Range("A6").AutoFilter
　End With
　　 Application.CutCopyMode = False
　　
End Sub


	【43249】Re:メッセージBoxの使い方？

事務員 - 06/10/6(金) 21:29 -


	引用なし

	パスワード

ToShiYoさん

正しく動くことを確認できました。
もし抽出条件入力のところで、8桁数字でない場合は、「入力直してください」という
メッセージをだすには、どのように書けば、可能になるでしょうか？

>Sub Auti_Fil_Copy()
>
>Sheets("SheetA").Activate
>　Range("A1").AutoFilter Field:=1, _
>　　Criteria1:=InputBox(Prompt:="適当に文字や数値を入力してみてください", _
>　　　Title:="Let's Excel VBA", _
>　　　　Default:="ここに入力します", _
>　　　　　XPos:=5800, YPos:=5400)
>　With Sheets("SheetB")
>　　　 .Activate
>　　　 .Cells.Clear
>　Sheets("SheetA").Range("A6").CurrentRegion.Copy
　　　　　　　　　　　　　　　↑A1変更
>　　 With .Range("A6")
　　　　　　　　　　↑A1変更
>　　　　　.PasteSpecial 1
>　　　　　.Select
>　　 End With
>　Sheets("SheetA").Range("A6").AutoFilter
　　　　　　　　　　　　　　↑A1変更
>　End With
>　　 Application.CutCopyMode = False
>　　
>End Sub


	【43250】Re:メッセージBoxの使い方？

ponpon - 06/10/6(金) 21:50 -


	引用なし

	パスワード

▼Jaka さん、事務員さん　こんばんは。
>「20060902」を入力したら、結果はでません。
とは？
コピペされない？
エラーが出る。→エラーメッセージを教えてください。

　　　　A　　　　B　　　　C　　　　D　　　　E
1　　　　項目１　　　　項目２　　　　項目３　　　　項目４　　　　項目５
2　　　　20060901　　　　あ　　　　1　　　　11　　　　101
3　　　　20060901　　　　い　　　　2　　　　12　　　　102
4　　　　20060902　　　　う　　　　3　　　　13　　　　103
5　　　　20060903　　　　え　　　　4　　　　14　　　　104
6　　　　20060904　　　　お　　　　5　　　　15　　　　105
7　　　　20060905　　　　か　　　　6　　　　16　　　　106
8　　　　20060906　　　　き　　　　7　　　　17　　　　107
9　　　　20060907　　　　く　　　　8　　　　18　　　　108
10　　　　20060908　　　　け　　　　9　　　　19　　　　109
11　　　　20060909　　　　こ　　　　10　　　　20　　　　110
12　　　　20060901　　　　さ　　　　11　　　　21　　　　111
13　　　　20060901　　　　し　　　　12　　　　22　　　　112

このようになっているとして、

>原因がわかってませんけど、こっちのが良くないですか？
そのようにしました。

Sub test()
　　Dim ret
　
　　Application.ScreenUpdating = True
　　Do
　　　ret = Application.InputBox(Prompt:="適当に文字や数値を入力してみてください", _
　　　　　　Title:="Let's Excel VBA", Default:="ここに入力します", Type:=1)
　　Loop Until Len(ret) = 8　'ここに桁数を指定してください
　　
　　Sheets("SheetB").Cells.ClearContents
　　With Sheets("SheetA")
　　　　.Range("A1").AutoFilter Field:=1, Criteria1:=ret, Operator:=xlAnd
　　　　If .AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Count = 1 Then
　　　　　 MsgBox "該当する数字はありません"
　　　　　 .Range("A1").AutoFilter
　　　　　 Exit Sub
　　　　Else
　　　　　 .AutoFilter.Range.Copy Sheets("SheetB").Range("A1")
　　　　End If
　　　　.Range("A1").AutoFilter
　　End With
　　Application.ScreenUpdating = True
End Sub

これで実行すると、
ちゃんとコピペされますが・・・

WinXP Excel2003です。
新規ブックにて試してみてください。


	【43251】Re:メッセージBoxの使い方？

ToShiYo - 06/10/6(金) 21:56 -


	引用なし

	パスワード

▼事務員さん：
A6がA1でしたね･･･失礼しました。当方A6でテストしていたものですから、
訂正できずに失礼しました。

>正しく動くことを確認できました。
>もし抽出条件入力のところで、8桁数字でない場合は、「入力直してください」という
>メッセージをだすには、どのように書けば、可能になるでしょうか？

ponpon様のコードをそのまま利用させていただければ、如何ですか？
下のコードを貼り付けて動かしてください。これでいけると思います。
A1に訂正していると思いますが、間違っていたら直してください。

Sub test5()
　　Dim ret

　　Application.ScreenUpdating = True
　　Do
　　　ret = Application.InputBox(Prompt:="8桁の数値を入力してください", _
　　　　　　Title:="Let's Excel VBA", Default:="8桁の数字を入力", Type:=1)
　　Loop Until Len(ret) = 8　'･･･ここに桁数を指定してください
　
　　Sheets("SheetB").Cells.ClearContents
　　With Sheets("SheetA")
　　　　.Range("A1").AutoFilter Field:=1, Criteria1:=ret
　　　If .Range("C:C").SpecialCells(xlCellTypeVisible).Rows.Count = 1 Then
　　　　　 MsgBox "該当する数字ではありません"& chr(10) & "入力し直してください"
　　　　　 .Range("A1").AutoFilter
　　　　　 Exit Sub
　　　　Else
　　　　　 .AutoFilter.Range.Copy Sheets("SheetB").Range("A1")
　　　　End If
　　　　.Range("A1").AutoFilter
　　End With
　　Application.ScreenUpdating = True
End Sub


	【43252】Re:メッセージBoxの使い方？

ToShiYo - 06/10/6(金) 22:08 -


	引用なし

	パスワード

▼事務員さん：

こんばんは一行訂正です

If .Range("C:C").SpecialCells(xlCellTypeVisible).Rows.Count = 1 Then
を
If .Range("A:A").SpecialCells(xlCellTypeVisible).Rows.Count = 1 Then
に訂正してください。

小生C列でテストしていたものですのでC:Cにしていました。
A列ですとA:Aに訂正です。また失礼しました。
では失礼します。


	【43306】Re:メッセージBoxの使い方？

事務員 - 06/10/8(日) 20:16 -


	引用なし

	パスワード

かみちゃんさん、
ToShiYo
ponponさん
Jakaさん
大変おせわになりました。
問題解決できました。


	【43311】Re:メッセージBoxの使い方？

ponpon - 06/10/8(日) 21:44 -


	引用なし

	パスワード

▼事務員さん：
もう見ていないかもしれませんが、

>問題解決できました。

どのように解決されたのでしょうか？

>「20060902」を入力したら、結果はでません。
コピペされないようでしたが・・・・


	【43379】Re:メッセージBoxの使い方？

事務員 - 06/10/12(木) 12:36 -


	引用なし

	パスワード

ponponさん

>どのように解決されたのでしょうか？
コードをCopyしただけです。
異常動作ありません。


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

6749 / 13644 ﾂﾘｰ

←次へ　｜　前へ→

ページ：

┃

記事番号：

(SS)C-BOARD v3.8 is Free