[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『検索を一つに』（ちょいボケ親父）
Sub 検索日付()
Dim st As Date, en As Date, co As Long
With Sheets("管理").Range("A1")
st = InputBox("開始日を入力してください")
en = InputBox("終了日を入力してください")
.AutoFilter Field:=1, Criteria1:=">=" & st, Operator:=xlAnd, Criteria2:="<=" & en
.CurrentRegion.SpecialCells(xlVisible).Copy Worksheets("検索").Range("A1")
.AutoFilter
End With
For co = 1 To 5
Worksheets("検索").Columns(i).ColumnWidth = _
Worksheets("管理").Columns(i).ColumnWidth
Next co
Worksheets("検索").Activate
End Sub
Sub 検索()
Dim i As Long, k As String
i = InputBox("列を指定してください")
SendKeys ("{kanji}")
k = InputBox("名前を入れてください")
With Worksheets("管理").Range("A1")
.AutoFilter Field:=i, Criteria1:=k
.CurrentRegion.SpecialCells(xlVisible).Copy Worksheets("検索").Range("A1")
.AutoFilter
End With
For i = 1 To 5
Worksheets("検索").Columns(i).ColumnWidth = _
Worksheets("管理").Columns(i).ColumnWidth
Next i
Worksheets("検索").Activate
End Sub
二つの検索を使っています、一つにしてみたのですが
単純に最初の 検索日付（）の End withの後ろに
検索を貼り付けただけですが、検索のinputboxを使いたい時も
検索日付から始まってキャンセルすると実行エラーがでます
st = inputbox("開始日を入力してください"）→キャンセル
en = InputBox("終了日を入力してください") ->キャンセル
としたら
i = InputBox("列を指定してください")
SendKeys ("{kanji}")
k = InputBox("名前を入れてください")
に進んでくれるには？どうしたらできますか
変数stとenの値により分岐処理すれば大丈夫では？
stとenがEmpty（キャンセル時）でなければ、１回目の検索（抽出？）を実行し、 Emptyの場合は飛ばして２回目のInputboxに行くようにする。
st = InputBox("開始日を入力してください")
en = InputBox("終了日を入力してください")
If st<>Empty And en<>Empty Then '〜１回目の検索処理〜 End If
i = InputBox("列を指定してください")
SendKeys ("{kanji}")
k = InputBox("名前を入れてください")
では、どうでしょうか？ (じゅんじゅん）
(じゅんじゅん）さん、ありがとうございます。 今、昼休みなので、今晩やってみます。急ぎお礼まで （ちょいボケ親父）
ちょいワル親父はん、それがしの推理が正しければかういうのも有効かと思われます。
でも、外していそう（笑
（弥太郎）
On Error Resume Next
st = InputBox("開始日を入力してください")
en = InputBox("終了日を入力してください")
If st * en = 0 Then
MsgBox "チャンと入力してくらはい"
Else
MsgBox "作業に取りかかります"
End If
メッセージが出ます。 Sub 検索日付()
Dim st As Date, en As Date, co, i As Long, k As String
With Sheets("管理").Range("A1")
st = InputBox("開始日を入力してください")
en = InputBox("終了日を入力してください")
If st <> Empty And en <> Empty Then
.AutoFilter Field:=1, Criteria1:=">=" & st, Operator:=xlAnd, Criteria2:="<=" & en
.CurrentRegion.SpecialCells(xlVisible).Copy Worksheets("検索").Range("A1")
.AutoFilter
End If
End With
i = InputBox("列を指定してください")
SendKeys ("{kanji}")
k = InputBox("名前を入れてください")
With Worksheets("管理").Range("A1")
.AutoFilter Field:=i, Criteria1:=k
.CurrentRegion.SpecialCells(xlVisible).Copy Worksheets("検索").Range("A1")
.AutoFilter
End With
場所まちがってますか？
(弥太郎)さん、ありがとうございます。 父の日プレゼントを貰ってから少しは理解できるようになりました。 ところで、ちょいワルは弥太郎さんでは?私はボケてますよ！ そんなことより、動きましたが、inputboxを全て"X"で押して終わらすと 最後に管理sheet全てが検索sheetにコピーされます。また 管理sheetはオートフィルターがかかったままになっています 作業に支障はないのですが気になったことです もう一つ、日付で絞って尚且つ品名で絞るには 日付でフィルターかけた後列と品名でかけるとダブってでます Sub 検索日付()
Dim st As Date, en As Date, co, i As Long, k As String
With Sheets("管理").Range("A1")
On Error Resume Next
st = InputBox("開始日を入力してください")
en = InputBox("終了日を入力してください")
If st * en = 0 Then
MsgBox "チャンと入力してください"
Else
MsgBox "作業に取りかかります"
End If
' If st <> Empty And en <> Empty Then
.AutoFilter Field:=1, Criteria1:=">=" & st, Operator:=xlAnd, Criteria2:="<=" & en
.CurrentRegion.SpecialCells(xlVisible).Copy Worksheets("検索").Range("A1")
.AutoFilter
' End If
End With
i = InputBox("列を指定してください")
SendKeys ("{kanji}")
k = InputBox("名前を入れてください")
With Worksheets("管理").Range("A1")
.AutoFilter Field:=i, Criteria1:=k
.CurrentRegion.SpecialCells(xlVisible).Copy Worksheets("検索").Range("A1")
.AutoFilter
End With
For co = 1 To 5
Worksheets("検索").Columns(co).ColumnWidth = _
Worksheets("管理").Columns(co).ColumnWidth
Next co
Worksheets("検索").Activate
End Sub
それと、もっと短く書けますか？色々すみませんが
よかったら、ぜひ、ぜひ 回答を
（ちょいワル）もとい （ちょいボケ親父）
If st<>Empty And en<>Empty Then 私の方は両方をキャンセルしていない時は、抽出を実行してしまいます。 抽出条件に片方だけ与える場合があるならば、ちょっと適さないかもです。
弥太郎さんご紹介のコードの場合、１回目の抽出は MsgBox "作業に取りかかります" ←ここに追加して行なうハズです。
開始日・終了日、列・名前を複合して条件として与えるのか、或いは片方だけに止めるのか どのような運用をお考えでしょうか？ (じゅんじゅん)
(じゅんじゅん)さん、ありがとうございます。 複合でやりたく、日で検索しないといけない時と、名前で検索と どうしても２通り必要です。なので、日付検索が表示されても enterキーで飛ばしていける方が良いのですが （ちょいボケ親父）
こんな感じでは？
st = InputBox("開始日")
If st = "" Then GoTo End_Sub
et = InputBox("終了日")
.
.
.
.
.
Exit Sub
End_Sub:
Call 検索
End Sub
(seiya)
・開始日及び終了日が双方入力される。 ・列及び名前が双方入力される。 ・上記内容が両立、或いは片方のみ条件が成立する。
Sub 検索日付()
Dim st As Date, en As Date, co, i As Integer, k As String
Dim sst, een, ii
With Sheets("管理").Range("A1")
sst = InputBox("開始日を入力してください")
een = InputBox("終了日を入力してください")
If IsDate(sst) And IsDate(een) Then
st = sst
en = een
.AutoFilter Field:=1, Criteria1:=">=" & st, Operator:=xlAnd, Criteria2:="<=" & en
End If
ii = InputBox("列を指定してください")
SendKeys ("{kanji}")
k = InputBox("名前を入れてください")
If ii <> "" And k <> "" Then
i = ii
.AutoFilter Field:=i, Criteria1:=k
End If
.CurrentRegion.SpecialCells(xlVisible).Copy Worksheets("検索").Range("A1")
.AutoFilter
End With
For co = 1 To 5
Worksheets("検索").Columns(co).ColumnWidth = _
Worksheets("管理").Columns(co).ColumnWidth
Next co
Worksheets("検索").Activate
End Sub
コピーしたブックで試してみて下さい。 (じゅんじゅん)
一部手直ししました。（じゅんじゅん）
ちょいボケ親父さん Sub を ひとつに纏めることより、条件によって分岐させると楽ですよ。 (seiya)
ごめんなはれや、あたしゃさういうつもりで書いたんとちゃいますんですワ。
ほんまは
If st * en = 0 Then
MsgBox "チャンと入力してください"
Exit Sub
Else
'次の作業のコードへ進む です
End If
×印で有ろうと空白であろうとInputBoxは変数の宣言によって得られる値は違って
きます。
デバックしてみればお分かりでっしゃろけど、Dateは00:00:00が変数に格納される筈で
ら（決してEmpty値ではありまへん）0*1も0*0も1*0もデータとして成立しまへん。
左様なことからどちらかのInputBoxが未入力でOKボタンを押しても×印を押しても0値
が格納されてこの作業自体が成立しなくなります。
これがValiantならEmpty stringなら"" integer long なら0がかえってきます。
事程左様に宣言した変数によって値が違ってきますから、色んな変数を宣言しては
デバックで確かめるんもひとつの勉強法ですワ。
（弥太郎）
弥太郎さんのコメントを読んで、私自身の理解不足を感じました。 勉強になりました。
あわせて私のコードは、双方でキャンセル等を行なっても最終的にコピーを実施してしまう、 と言う状態でした。 情けないっす。 (じゅんじゅん)
(じゅんじゅん）さん、（弥太郎）さん、(seiya)さん、ありがとうございます。
(seiya)さん
Sub を ひとつに纏めることより、条件によって分岐させると楽ですよ ！ は
st = InputBox("開始日")
If st = "" Then GoTo End_Sub
et = InputBox("終了日")
.
.
.
.
.
Exit Sub
End_Sub:
Call 検索
End Sub
のことでしょうか？....はどの範囲をいれれば
まだまだ応用がききません （ちょいボケ親父）
このようにしたらいかがでしょう。
Sub Main()
Dim st, et
st = InputBox("開始日を入力してください")
et = InputBox("終了日を入力してください")
If IsDate(st) * IsDate(et) Then '<- 日付を入力した場合
検索日付 CDate(st), CDate(et) '<- 変数を渡す
Else
検索 st, et '<- 変数を渡す（日付以外）
End If
End Sub
Sub 検索日付(mySt As Date, myEt As Date) (以下コード中のInputoboxを削除して、 コード中のst, et を夫々 mySt, myEt に変更) End Sub
Sub 検索(mySt As String, myEt As String) （同上) End Sub (seiya)
isdate と cdateは調べて意味は解りましたが、質問 IsDate(st) * IsDate(et)の*はどのような意味ですか？ 昼休みなので、まだ、構文変更していませんが よろしければ （ちょいボケ親父）
And でも同じ結果になりますｂ ちなみに、+ は Or と同じ結果を返しますよｂ (ROUGE)
ROUGEさんが既に回答されていますが、 このように考えてください。
vba では 0 = False, それ以外（本来の値は-1) = True とみなされます。 IsDate(st) * IsDate(et) どちらかが 0(False)になると 0 * ? = 0 = False となり、And と同じ結果になります。
+ の場合はどちらか一方が <>0 であれば ? + 0以外 = True となり、Or と同じ結果になります。
一般に、And/Or 関数を使用しないので、いくらか速いといわれています。 (seiya)
下から失礼します。 >一般に、And/Or 関数を使用しないので、いくらか速いといわれています。 へ〜 そういうものだったんですね〜 勉強になりましたｂ お邪魔しました＾＾ （キリキ）(〃⌒o⌒)b
Sub Main()
Dim st, et
st = InputBox("開始日を入力してください")
et = InputBox("終了日を入力してください")
If IsDate(st) * IsDate(et) Then '<- 日付を入力した場合
検索日付 CDate(st), CDate(et) '<- 変数を渡す
Else
検索 st, et '<- 変数を渡す（日付以外）
End If
End Sub
Sub 検索日付(mySt As Date, myEt As Date)
' (以下コード中のInputoboxを削除して、 コード中のst, et を夫々 mySt, myEt に変更)
With Sheets("管理").Range("A1")
If mySt * myEt = 0 Then
MsgBox "チャンと入力してください"
Else
MsgBox "作業に取りかかります"
End If
.AutoFilter Field:=1, Criteria1:=">=" & mySt, Operator:=xlAnd, Criteria2:="<=" & myEt
.CurrentRegion.SpecialCells(xlVisible).Copy Sheets("検索").Range("A1")
.AutoFilter
End With
End Sub
Sub 検索(mySt As String, myEt As String)
With Sheets("管理").Range("A1")
.AutoFilter Field:=myst, Criteria1:=myet
.CurrentRegion.SpecialCells(xlVisible).Copy Sheets("検索").Range("A1")
.AutoFilter
End With
' （同上)
End Sub
Sub Main()を実行すると"コンパイルエラー"Byref"の型が一致しません。とでます どこを、直したら （ちょいボケ親父）
変数の型が自動的に変換されない http://support.microsoft.com/kb/213562/ja エラーの回避方法としてはこのような感じかと。 ご参考までに。 (じゅんじゅん)
>Sub Main() >"コンパイルエラー"Byref"の型が一致しません。とでます
>Sub Main()
>Dim st, et
Main()で、st,et は、バリアントとして定義されていますから、
検索()のここが型違いと云うことだと思います。
↓ ↓
>Sub 検索(mySt As String, myEt As String)
Sub 検索(mySt, myEt) ↑ 単に これでいいと思います。
ところで、そこで受け取った引数をコード内で利用されていますか？ 明示的に定義されていない「i」とか「k」が記述されていますが、、、 (半平太)
半平太さんのご指摘は、ページ更新後気がつき直しました。 Sub 検索(mySt, myEt)にしてみたら、動きましたが、 検索日付だけで、検索になりません？検索は列と品名での検索なので 検索日付と同じように（mySt, myEt）がはいるのでしょうか？ そこが少し疑問です?
>検索日付と同じように（mySt, myEt）がはいるのでしょうか？
始めの方のやり取りは、詳しく見ていませんが、、、
列と品名での検索なら、mySt, myEt、は要らないです。 (「i」の代わりでもなければ、「k」の代わりになるものではないとしたら、ですが。。）
そうなると、「i」と「k」には、何時正しいデータが格納されるのですか？
(半平太)
んーよく分からんけど
st = InputBox("開始日を入力してください")
et = InputBox("終了日を入力してください")
↓
st = InputBox("開始日、または検索列を入力してください")
et = InputBox("終了日、または検索名称を入力してください")
ってことですか？
（ご近所PG）悩んでるのは。
(半平太)さん、（ご近所PG)さん、ありがとうございます。 （ご近所PG)さんのヒントで解決しました。（ちょいボケ親父）
皆さんフォローありがとうございます。
検索 CInt(Val(st)), CStr(et)
Sub 検索(mySt As Long, myEt As String)
で渡してやればよさそうな... (seiya)
(seiya)さん、ありがとうございます。 ちょっと空けてまして、遅くなりました。
Sub 検索(mySt As Long, myEt As String)
Dim co As Long
With Sheets("管理").Range("A1")
On Error Resume Next
If mySt * myEt = 0 Then
MsgBox "チャンと入力してください"
Else
MsgBox "作業に取りかかります"
End If
.AutoFilter Field:=mySt, Criteria1:=myEt
.CurrentRegion.SpecialCells(xlVisible).Copy Sheets("検索").Range("A1")
.AutoFilter
End With
For co = 1 To 5
Sheets("検索").Columns(co).ColumnWidth = _
Sheets("管理").Columns(co).ColumnWidth
Next co
Sheets("検索").Activate
' （同上)
End Sub
に変更しましたが、列番号と検索文字をいれると
msgboxが"チャンと入力してください"になります。
日付検索はうまくいきます。？？？
検索 CInt(Val(st)), CStr(et)は、Sub Main() の
Else
検索 st, et を変更しました。（ちょいボケ親父）
On Error Resume Next を実行している事で、正確なエラー内容が得られないと思います。 一度コメントにしてみて、どこでエラーになるか確認してみては？ (じゅんじゅん)
If mySt * myEt = 0 Then でエラーがでます、"型が一致しません" dateに変えても同じ結果でした、variantも同じです （ちょいボケ親父）
myEt は String型の変数ですよね？ mySt は Long型なのでよいとしても、 たとえば mySt = 1、myEt = "ちょいワル親父" だとしたら、 mySt * myEt = 1 * "ちょいワル親父" = ??? = エラー となりますよ。 myEt に何か入っていることを調べるのであれば、 mySt * Len(myEt) = 0 とされてはどうでしょうか？ (ROUGE)
その行の目的が今ひとつ不明ですが、エラー処理ならMainの方でしてしまった方が わかりやすいと思うのですが？ (seiya)
自分なりに考えて Sub Main() Dim st, et
st = InputBox("開始日を入力してください")
et = InputBox("終了日を入力してください")
If IsDate(st) * IsDate(et) Then '<- 日付を入力した場合
検索日付 CDate(st), CDate(et) '<- 変数を渡す
Else
' 検索 st, et '<- 変数を渡す（日付以外）
On Error GoTo ermsg
検索 CInt(Val(st)), CStr(et)
Exit Sub
ermsg:
MsgBox "何も入力されませんでした。"
End If End Sub ご指摘のように"Main"にエラー処理をしました。なんとかうごいてますが こんなんで、良いのか？ （ちょいボケ親父）
ROUGEさんの回答を参考にさせて頂くと、
If IsDate(st) * IsDate(et) Then '<- 日付を入力した場合
検索日付 CDate(st), CDate(et) '<- 変数を渡す
ElseIf CInt(Val(st)) * Len(CStr(et)) > 0 Then
' 列番号が１以上で、且つ文字列数が１以上を満たす場合
' 検索 st, et '<- 変数を渡す（日付以外）
検索 CInt(Val(st)), CStr(et)
Else
' 入力されたデータが渡せない場合
MsgBox "チャンと入力して下さい"
Exit Sub
End If
では、どうでしょうか？ (じゅんじゅん)
思った様になりました。 (じゅんじゅん）さん、(seiya)さん、(Rouge)さん、本当に長々付き合っていただき 感謝です。他のみなさんも、ありがとう （ちょいボケ親父）、またね
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.