[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『期間内の [最大値] [最小値] を求める』（jun53）
弥太郎様、宜しくお願いします。
A B 1 02/03/20 540 2 02/03/21 260 3 02/03/22 380 4 02/03/23 590 5 02/03/24 595 6 02/03/25 850 7 02/03/26 600 8 02/03/27 425 9 02/03/28 770 10 02/03/29 11 02/03/30 640
のようなデータが有って、指定期間内の [最大値] [最小値] を求めたいのです（日数は取り消しです） 関数でも何とか出せるのですが、それをスマートに？
InputBox で 例えば [02/03/22] [02/03/28] と入力して（西暦は４桁でも結構です） その期間内の [最大値]を D1 [最小値]を E1 に [最大値の日付]を D2 [最小値の日付]を E2 に出るようにしたいのです。 Box の代わりに特定セルに打込みでも。 （Box の場合入力した日付がセルにも反映されればいいのですが） ということは、セル入力が一番いい？
実際の期間は３年半くらい 1300行前後（増えました） 時系列に並んでます。 日付は有るけど数値のほうは 0 或いは空白のものが有り得るのでそれは無視して最小で 1 です。 ヒットが重複したら新しいほうの日付のもの（無理ならおまかせです） できたら ’付コードコメントが有れば嬉しいです。 こんな事が可能でしょうか？ 注文が多くてすみません。無理な部分は省いて結構です。
期限は明朝５時迄･････ うそで〜〜す 急ぐものでは有りませんので、可能でしたらお暇な時に宜しくお願い致します。 コード内の player name はご勘弁を（笑）
おもしろそ〜、ながめてよ〜。（ケン）
最近、"弥"の字さん 控えめですよ。 VBAのVセンサーを外しているのかも。 このスレッドの表題に "弥太郎さん"とか"VBA"とかを 入れたほうがいいかも。（EUREKA)
最大値・最小値を求めるには、日付を C1、C2 に入力
D1=MAX(INDIRECT("b"&MATCH($C$1,A:A)):INDIRECT("b"&MATCH($C$2,A:A)))
E1=MIN(INDIRECT("b"&MATCH($C$1,A:A)):INDIRECT("b"&MATCH($C$2,A:A)))
としてみました。（エクセル勉強中）
と言うスレッドが有ったのです。（ケン）
ふふ みなさん張り切ってますね ケンさん ありがとう 弥太郎さん、お待ちしてますよ♪ （jun53）
お〜いjunちゃ〜ん！ ごめん、さっき帰って見つけた所やで。さぼっとったんとちゃうさかいな。 ところで、空白行、もしくは０表示のセルは１として（最小値として）評価せえっ ちゅうことでっか？ それと「’付きコメント」ってどういう事？セルに拾い出したデータにコメントを入れ ろっちゅうことでっか？ 早い事おせえてんか。 まぁ、今日は野球無いからかめへんけどな、頼んだで。 （やる気満々の 弥太郎）
違いますよ。あの緑に変わるコードには関係のないコメントて言う事だと思いますよ。 完成を楽しみに待っている（ケン）
ほんならで〜けた。
こんな感じでどうでしょうか(ken!)
'--------------
Option Explicit
'---------------
Sub picup()
Dim i As Integer, big As Integer, smal As Integer
Dim data As String, data_b As Date, data_c As Date
Dim data_a As Variant
Range("d1:g2").Clear
Range("iu1:iv2000").Clear '最大値、最小値を求める作業台
On Error GoTo trbl
data = InputBox("拾い出す期間は？" & Chr(13) & _
"ハイフン (-) で区切って入力して下さい。", "期間の指定")
data = StrConv(data, vbNarrow) 'データを半角に変換
[f1] = data
data_a = Split(data, "-") 'ハイフンで２つのデータに分ける
data_b = DateValue(data_a(0)) '開始の日付
data_c = DateValue(data_a(1)) '終了の日付
If Cells(2, 6) > Cells(2, 7) Then GoTo trbl
i = 1 '↑開始より終了の日付が浅い場合のエラー処理
Do
If Cells(i, 1) >= data_b And Cells(i, 1) <= data_c Then '期間内の選択
Cells(i, 255) = Cells(i, 1).Text '作業テーブルへ転記
Cells(i, 256) = Cells(i, 2) '作業テーブルへ転記
End If
i = i + 1
Loop While Cells(i, 1) <> "" And Cells(i, 1) <= data_c 'loopからのの脱出条件
Range("d1") = Application.Max(Range("iv1:iv" & i)) '最大値の拾い出し
big = Application.Match(Range("d1"), Range("iv1 :iv" & i), 0) 'そのアドレス探し
Range("d2") = Cells(big, 1) 'アドレス転記
Range("e1") = Application.Min(Range("iv1:iv" & i)) '最小値の拾い出し
smal = Application.Match(Range("e1"), Range("iv1:iv" & i), 0) 'そのアドレス探し
Range("e2") = Cells(smal, 1) 'アドレス転記
Range("d2:e2").NumberFormatLocal = "yy/mm/dd" '書式の設定
Exit Sub
trbl:
MsgBox "入力が間違ってますっ！ やり直して下さい。" 'エラーメッセージ
End Sub
アカンわ、そういや同データの場合は新しい方を選択せよっちゅう注文やったなぁ。 ニーズに応えんかたら、ギャラもらわれへん。 も１ぺん考えよう〜っと。
弥太郎さんの最初のコメントを見て書いたものです。もうコードが出てる。せっかく書いたから載せます。 ************** >空白行、もしくは０表示のセルは１として（最小値として） は、通常関数では =MIN(0,1,2,3,4,5) の最小値は 0 と出ますので 0 を除いた 1 を最小と判断してもらいたいのです。=MIN(0,5,6,7,8) なら 5 という具合です。面倒かけます。
>「’付きコメント」 はケンさんの仰有ってる通りです（コード説明）。これを書いて頂ければ もしかして自分が最終的に思ってるコードに膨らませる事ができるかもしれない、、、かもです。
でも本当に、ゆっくりのんびりでいいんですよ。あまり負担に思われるのもこちらの本意ではありませんから。 それでは宜しくお願いします。 （jun53） ************** >アカンわ らしいですけどこれから一度試して見ます。
それ試さんでもよろしいわ、もうでけてもたから。
コレと差し替えておくんなはれ。
ケンショウブソク（１回だけ）かもしれまへんけど、しっかりアラ捜しておくんなはれ
や。
ほな...（商売繁盛の 弥太郎）
'------------------
Option Explicit
'-----------------
Sub picup2()
Dim i As Integer, big As Integer, smal As Integer, n As Integer
Dim data As String, data_b As Date, data_c As Date
Dim data_a As Variant
Range("d1:g2").Clear
Range("iu1:iv2000").Clear '最大値、最小値を求める作業台
On Error GoTo trbl
data = InputBox("拾い出す期間は？" & Chr(13) & _
"ハイフン (-) で区切って入力して下さい。", "期間の指定")
data = StrConv(data, vbNarrow) 'データを半角に変換
[f1] = data
data_a = Split(data, "-") 'ハイフンで２つのデータに分ける
data_b = DateValue(data_a(0)) '開始の日付
data_c = DateValue(data_a(1)) '終了の日付
If Cells(2, 6) > Cells(2, 7) Then GoTo trbl
i = 1 '↑開始より終了の日付が浅い場合のエラー処理
Do
If Cells(i, 1) >= data_b And Cells(i, 1) <= data_c Then '期間内の選択
Cells(i, 255) = Cells(i, 1).Text '作業テーブルへ転記
Cells(i, 256) = Cells(i, 2) '作業テーブルへ転記
End If
i = i + 1
Loop While Cells(i, 1) <> "" And Cells(i, 1) <= data_c 'loopからのの脱出条件
big = Application.Max(Range("iv1:iv" & i)) '最大値の拾い出し
smal = Application.Min(Range("iv1:iv" & i)) '最小値の拾い出し
n = i
Do
i = i - 1
If Cells(i, 256) = big Then '新しい順番検索
Range("d1") = big
Range("d2") = Cells(i, 1)
Exit Do
End If
Loop While i <> 1
Do
n = n - 1
If Cells(n, 256) = smal Then '新しい順番検索
Range("e1") = smal
Range("e2") = Cells(n, 1)
Exit Do
End If
Loop While n <> 1
Range("d2:e2").NumberFormatLocal = "yy/mm/dd" '書式の設定
Exit Sub
trbl:
MsgBox "入力が間違ってますっ！ やり直して下さい。" 'エラーメッセージ
End Sub
Exit Doが抜けとった〜っ。訂正したでっ。 （チョンボの 弥太）
弥太郎さん、お手数かけます。 試用報告は夜９時か１０時頃になりますが、有り難うございました。 （jun53）
弥太郎さん、私もお礼を言っておきます。ゆっくり勉強さしてもらいます。（ケン）
ミスショット発見、ミスショット発見。 If Cells(2, 6) > Cells(2, 7) Then GoTo trbl 最初F2,G2を作業台に使うつもりで書いたったんが、直接変数を使用するように変更し 正しくは If data_b > data_c Then GoTo trbl ですわ。
Cells(i, 255) = Cells(i, 1).Text '作業テーブルへ転記 この欄は新しい順番で検索するように変更したんで不要になります。
チェックせなアカンもんやなぁ。危うくイチャモン付けられるとこやったわ。(^^;; 本日のインターネット終了。 （早寝遅起きの 弥太郎）
フーー 修正して再トライしたけど GoTo trbl ですねん。 拾い出しと順番検索のつながりのところでしょうかねぇ。。。
明日又 ゆっくり時間をつくって挑戦してみます。 弥太郎さん、良い夢を見て下さい。 （jun53）
Wh〜y? おはようございます。junちゃんの威勢のええタンカ聞きたかったのに、エライ苦吟 しとるみたいでんなぁ。 原因は多分変数の宣言ですわ。junちゃんの呈示してくれた標本には大きい数字がおま へんでしたさかいintegerで宣言しましたけど、チョッと思いを巡らせたらlongで宣言 すべきでしたわ。これに差し替えてみておくんなはれ。
Dim i As Integer, n As Integer
Dim data As String, data_b As Date, data_c As Date
Dim data_a As Variant
Dim big As Long, smal As Long
もし原因がこれやったら、悪いんはデータの提供者であって、決して弥太が悪いんや おまへんねんで、えぇ、えぇ。
まぁ、起き抜けの頭の体操でいっぺん廻してみておくんなはれ。 寝起きの悪いjunしゃんへ （おいぼれ 弥太郎）
チョット遅めの、おはようございます。 integer と long ですか 以前此処でその話を見た覚えがありますが･･･ すみません、数値には５桁６桁７桁も有り得まして、、、私が回答者なら「データは全部出さんかい！」となりますねー。 何の数字かって？ わたしの一日の小遣いです。。long宣言で億単位にもスイスイ廻ってます。
0 対策は
If Application.Min(Range("iv1:iv" & i)) = 0 Then '最小値の拾い出し
以下、幾つか考えたのですが未だ未完成。これからじっくり考えます。
「のんびり週末」をわざわざありがとうございました。 （jun53）
>わたしの一日の小遣いです ほんじゃまあ、成功した暁にはたっぷりギャラ請求でけますなぁ、へへへ。 ざっと見積もって４しぇん万円位で手ぇ打ちまひょか。 送り先は「日本エクセル協会 VBA初心者クラブ ケン様」宛に 不渡り小切手で お願いしときまっさ。
ところで、０の扱いはケンショウしてまへんでしたわ。ここらへんの詰めは相も変わら ず甘い弥太郎でんねん、えぇ。 いいええな、他の方にはあらゆる事を想定してケンショウしまんねんで、ホンマのとこ ろ。これはjunちゃんに対する甘えがそうさせたんちゃいまっか（自分の頭ゴツン）。 ０の扱いはこうしておくんなはれ。最初のDoの欄の差し替えですわ。
Do
If Cells(i, 1) >= data_b And Cells(i, 1) <= data_c Then '期間内の選択
If Cells(i, 2) = 0 Then
Cells(i, 256) = "" '0は最小値として拾わんように空セルで！
Else
Cells(i, 256) = Cells(i, 2) '作業テーブルへ転記
End If
End If
i = i + 1
Loop While Cells(i, 1) <> "" And Cells(i, 1) <= data_c 'loopからのの脱出条件
悩んでもろても良かったんですけど、ほら、最近の若者の台頭ぶりはめざましいモンが おますさかい、あんまり根詰めてやられると私の立場が危ううなりますんでな。 さっさとケリ付けて腕前の上がるんを阻止しとかなアカンのんが本音ですわ、えぇ。
そういや、「E」のバッジを付けた風紀委員が見回りに来てましたなぁ。見つからんよ うにこの辺で切り上げまっさ。 ほな...（おいぼれ 弥太郎）
>不渡り小切手 のし付けてお返しします。（ケン）
お礼は小切手では無く、わたし名義のキャッシュカードを早速送りました。 暗証番号は [USO800] です。
0 対策は If で Small を使って、、、せいぜいこのくらいしか思いつかず。 転記の段階で、はじいてしまう。 なるほどです。 巨匠ともなると、このくらい朝飯前ですね。 ← 巨匠 は、削除
お陰様で、これから自分流コードにいじる目処が付きました。 感謝致します。 （jun53）
風紀委員ってワテのことかいな。
カナンの地と言いつつ通りすがりの者、 弥の字の得意をパクッて啓示録Ｖを記す。
皆さん、有能な上に、吸収しあっているじゃないですか。
ほな〜 （EUREKA)
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.