Excel VBA質問箱 IV

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

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

  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
6086 / 13646 ﾂﾘｰ ←次へ　｜　前へ→
▼ 【47286】条件付の最大値の求め方 kei 07/3/7(水) 12:30 質問[未読]
【47287】Re:条件付の最大値の求め方 Jaka 07/3/7(水) 13:18 発言[未読]
【47288】Re:条件付の最大値の求め方 ウッシ 07/3/7(水) 13:39 回答[未読]
【47305】Re:条件付の最大値の求め方 Hirofumi 07/3/7(水) 18:44 回答[未読]
【47286】条件付の最大値の求め方
質問  kei  - 07/3/7(水) 12:30 -
引用なし
パスワード
   いつもお世話になっておりますぅ！
相変わらずド素人な質問ばかりで申し訳御座いません・・・

CommandButton1をクリックした時、
A列にある数値の1000以上2000以下の最大値を求めたいのです。

お願い致しますっ！
【47287】Re:条件付の最大値の求め方
発言  Jaka  - 07/3/7(水) 13:18 -
引用なし
パスワード
   エクセル関数だとこんな感じになります。
=SUMPRODUCT(MAX((A1:A65535>=1000)*(A1:A65535<=2000)*(A1:A65535)))
注）１〜65536行（つまり１列全部）だとエラーになります。
　　また、65535行までが対象だと重くなると思いますから、
　　適当に小さくしてください。

これをマクロでやるとこんな感じ。

EnDRw = Cells(Rows.Count, 1).End(xlUp).Row
関数式 = "SUMPRODUCT(MAX((A1:A" & EnDRw & ">=1000)*(A1:A" & EnDRw & "<=2000)*(A1:A" & EnDRw & ")))"
MsgBox Application.Evaluate(関数式)
【47288】Re:条件付の最大値の求め方
回答  ウッシ  - 07/3/7(水) 13:39 -
引用なし
パスワード
   ▼kei さん：
>いつもお世話になっておりますぅ！
>相変わらずド素人な質問ばかりで申し訳御座いません・・・
>
>CommandButton1をクリックした時、
>A列にある数値の1000以上2000以下の最大値を求めたいのです。
>
>お願い致しますっ！

こんにちは

こんなのも、

Sub test()
　　Dim i　　　As Long
　　Dim r　　　As Range
　　Dim v　　　As Variant
　　Dim rs　　 As Object
　　
　　Set r = Worksheets("Sheet1").UsedRange.Columns(1).Cells
　　If r Is Nothing Then Exit Sub
　　
　　v = r.Value
　　Set rs = CreateObject("ADODB.Recordset")

　　With rs
　　　　.Fields.Append "Data", 14
　　　　.Open
　　　　
　　　　For i = LBound(v) To UBound(v)
　　　　　　If IsNumeric(v(i, 1)) Then
　　　　　　　　.AddNew
　　　　　　　　!Data = v(i, 1)
　　　　　　End If
　　　　Next
　　　　Set r = Nothing
　　　　Erase v
　　　　.Filter = "Data >= 1000 AND Data <= 2000"
　　　　If .RecordCount > 0 Then
　　　　　　.Sort = "[Data] DESC"
　　　　　　v = .GetRows(1, 0, "Data")
　　　　　　MsgBox "1000以上2000以下の最大値は「" & v(0, 0) & "」"
　　　　Else
　　　　　　MsgBox "抽出エラー"
　　　　End If
　　　　.Close
　　End With
　　Erase v
　　Set rs = Nothing
End Sub
【47305】Re:条件付の最大値の求め方
回答  Hirofumi  - 07/3/7(水) 18:44 -
引用なし
パスワード
   こんなのでも？

Option Explicit

Public Sub Sample()

　　Dim i As Long
　　Dim lngRows As Long
　　Dim vntData As Variant
　　Dim vntMax As Variant
　　Dim strProm As String
　　
　　With ActiveSheet.Cells(1, "A")
　　　　'データ行数を取得
　　　　lngRows = .Offset(Rows.Count - .Row) _
　　　　　　　　　　　　　　　　.End(xlUp).Row - .Row + 1
　　　　'データが無い場合
　　　　If lngRows <= 1 And .Value = "" Then
　　　　　　strProm = "データが有りません"
　　　　　　GoTo Wayout
　　　　End If
　　　　'データを配列に取得
　　　　vntData = .Resize(lngRows + 1).Value
　　End With
　　
　　For i = 1 To lngRows
　　　　'値が1000以上、2000以下なら
　　　　If 1000 <= Val(vntData(i, 1)) _
　　　　　　　　And Val(vntData(i, 1)) <= 2000 Then
　　　　　　'保存した値より、データが大きいなら
　　　　　　If vntMax < Val(vntData(i, 1)) Then
　　　　　　　　'データを保存
　　　　　　　　vntMax = Val(vntData(i, 1))
　　　　　　End If
　　　　End If
　　Next i
　　
　　If vntMax = Empty Then
　　　　strProm = "該当データが有りません"
　　Else
　　　　strProm = "1000以上、2000以下の最大値は、" & vntMax & "です"
　　End If
　　
Wayout:
　　
　　MsgBox strProm, vbInformation
　　
End Sub
  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
6086 / 13646 ﾂﾘｰ ←次へ　｜　前へ→
ページ：  ┃  記事番号：
2610219
(SS)C-BOARD v3.8 is Free