指定した範囲内で最大値及び最小値のセル番地を取得するには、
どうコーディングしたらよろしいでしょうか?
対象範囲 A1:Z2000の各行(行番は変数で処理)
例えば、
----------------------------------------------------
For x = 1 To 2000
Range(A列のx行目:A列のx行目)の最大値 → B列
最小値 → Y列
Next x
----------------------------------------------------
このように、2000行分同じことを繰り返し、それぞれの行内での
最大値及び最小値を含むセルの列名を取得し、
B列のx行目を赤(最大値)
Y列のx行目を青(最小値)
に着色したいのです。
よろしくお願いします。
No.4ベストアンサー
- 回答日時:
#1です。
高速化してみました。
配列は使ってません。
Sub test2()
Dim x As Long, y As Long, ct As Long
Dim myLastRow As Long, myLastCol As Long
Dim myMatchMaxCol As Long, myMatchMinCol As Long
Dim myMax As Double, myMIn As Double
Dim myRng As Range
myLastRow = Cells(Rows.Count, 1).End(xlUp).Row
myLastCol = Cells(1, Columns.Count).End(xlToLeft).Column
Application.ScreenUpdating = False
Range("A1").CurrentRegion.Interior.ColorIndex = xlNone
For x = 1 To myLastRow
Set myRng = Range(Cells(x, 1), Cells(x, myLastCol))
myMax = Application.WorksheetFunction.Max(myRng)
myMIn = Application.WorksheetFunction.Min(myRng)
myMatchMaxCol = Application.Match(myMax, myRng, 0)
myMatchMinCol = Application.Match(myMIn, myRng, 0)
Cells(x, myMatchMaxCol).Interior.ColorIndex = 3
Cells(x, myMatchMinCol).Interior.ColorIndex = 5
Next x
Application.ScreenUpdating = True
Set myRng = Nothing
End Sub
No.5
- 回答日時:
#3です。
もはや完全な余談ですが、もともとセルに対するアクセスは最小限にとどめているコードですが、
#1さんの真似をして、Application.ScreenUpdating = Falseを取り入れると、試験データ生成部を除いたコードで、2329msec→2078msecと、1割位速くなりました。(時間は精度アップ対策をしたtimeGetTime APIで測定しているつもり)ご参考まで。
何度もご回答いただき、ありがとうございました!
Application.ScreenUpdating = False
これを取り入れると劇的に高速化しますね。
誠に申し訳ないのですが、
ソースは読解できなかったので今回は使用できなかったのですが、
スキルアップした際にはこの質問・ご回答をもう一度見直し、
是非とも参考にさせていただきたく思います。
No.3
- 回答日時:
徒然なるままに、こしらえてみました。
最近高速化に凝っていますので、配列に入れて、オーソドックスな方法でやっています。実行時間はテストデータ生成を含めて3秒位でした(5年位前のCeleron機)採用されるときは、sh.Cells.Clearと、試験用データ生成部を削除してください。(当方XL2000です)Sub test()
Dim tempArray As Variant
Dim i As Long, j As Long
Dim maxValue As Double, minValue As Double
Dim maxColumn As Long, minColumn As Long
Dim sh As Worksheet
Debug.Print Now
Set sh = ThisWorkbook.Sheets("Sheet1")
sh.Cells.Clear
tempArray = sh.Range("A1:Z2000")
'試験用データの生成
Randomize Now
For i = 1 To UBound(tempArray, 1)
For j = 1 To UBound(tempArray, 2)
tempArray(i, j) = Rnd() * 1000
Next j
Next i
Sheets("Sheet1").Range("A1:Z2000").Value = tempArray
Debug.Print Now
'ここからが本題
For i = 1 To UBound(tempArray, 1)
minValue = tempArray(i, 1): minColumn = 1
maxValue = tempArray(i, 1): maxColumn = 1
For j = 2 To UBound(tempArray, 2)
If minValue > tempArray(i, j) Then
minValue = tempArray(i, j)
minColumn = j
End If
If maxValue < tempArray(i, j) Then
maxValue = tempArray(i, j)
maxColumn = j
End If
Next j
With sh
.Cells(i, maxColumn).Interior.ColorIndex = 3
.Cells(i, minColumn).Interior.ColorIndex = 5
End With
Next i
Debug.Print Now
End Sub
No.2
- 回答日時:
#1です。
VBAの一例です。
Sub test1()
Dim x As Long, y As Long
Dim myLastRow As Long
Dim myMax As Double, myMIn As Double
myLastRow = Cells(Rows.Count, "A").End(xlUp).Row
For x = 1 To myLastRow
myMax = Application.WorksheetFunction.Max(Range(Cells(x, "A"), Cells(x, "Z")))
myMIn = Application.WorksheetFunction.Min(Range(Cells(x, "A"), Cells(x, "Z")))
For y = 1 To Range("Z1").Column
If Cells(x, y).Value = myMax Then
Cells(x, y).Interior.ColorIndex = 3
ElseIf Cells(x, y).Value = myMIn Then
Cells(x, y).Interior.ColorIndex = 5
Else
Cells(x, y).Interior.ColorIndex = xlNone
End If
Next y
Next x
End Sub
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Visual Basic(VBA) 指定列最終行までのスペースを改行するVBAについて 2 2022/06/01 19:50
- Visual Basic(VBA) vba 等間隔の列に対しての計算 6 2022/05/17 20:15
- Visual Basic(VBA) 最終列の右へSUM関数を作成するため下記コードを実行しましたが、最終列「10月28日」が上書きされて 3 2022/12/05 20:32
- Excel(エクセル) 単価シートから単価をエクセル関数で自動取得する方法 1 2023/07/02 22:00
- Visual Basic(VBA) 複数csvを横に追加していくマクロについて 2 2023/04/25 09:19
- Visual Basic(VBA) 3つのプロシージャをまとめたら実行時エラー発生で対応不能 6 2022/05/17 01:47
- Visual Basic(VBA) Excel VBA 最終行を取得しVlookup関数をコピーする方法をコーディングで教えてください。 3 2023/05/11 13:14
- Visual Basic(VBA) 最終行の指定について教えてください。 複数シートを1シートへまとめる下記マクロでは各シートの6行目を 1 2022/10/04 18:37
- Visual Basic(VBA) 貼り付けた値が消えていく 以下はソースファイルの2番目のシートのB6から最終行を取得 ターゲットファ 2 2023/07/27 12:23
- Visual Basic(VBA) VBA 検索と入力 Excel ブック ぶぶぶ シート ししし 列V 検索対象の列です 最終行は、お 6 2023/05/17 01:40
このQ&Aを見た人はこんなQ&Aも見ています
-
プロが教える店舗&オフィスのセキュリティ対策術
中・小規模の店舗やオフィスのセキュリティセキュリティ対策について、プロにどう対策すべきか 何を注意すべきかを教えていただきました!
-
最大値のあるセルの行番号のみを求めたいです。
Excel(エクセル)
-
2つ以上の変数を比較して最大数を求めたい
Word(ワード)
-
EXCEL VBAで全選択範囲の解除
Excel(エクセル)
-
-
4
EXCEL VBA セルに既に入力されている文字に文字を追加する
Excel(エクセル)
-
5
最大値となるセルの絶対番地を知りたいのです。
Excel(エクセル)
-
6
VBAでループ内で使う変数名を可変にできないか。
Visual Basic(VBA)
-
7
配列の中の最大値とそのインデックス番号を取得する方法
Visual Basic(VBA)
-
8
範囲内で最大値を見つけ、その隣のセルの値を返す
Visual Basic(VBA)
-
9
Excelの条件付き書式設定の太い罫線
Excel(エクセル)
-
10
エクセルのエラーメッセージ「400」って?
Visual Basic(VBA)
-
11
エクセルで、最大値があるセルの位置を探したい
Excel(エクセル)
-
12
最も近い数値のあるセルを探す
Excel(エクセル)
-
13
Excel マクロ:変数を複数使う場合
Excel(エクセル)
-
14
EXCEL VBAで、セルの文字列の前後に文字を入力する方法は?
その他(Microsoft Office)
-
15
VBAでの一時停止と再開の方法
その他(プログラミング・Web制作)
-
16
マクロ F8が効かない
Excel(エクセル)
-
17
マクロの「SaveAs」でエラーが出るのを解消したいです(再)
Visual Basic(VBA)
-
18
【EXCEL】【VBA】空欄は飛ばして処理する方法を教えて下さい。
Excel(エクセル)
-
19
Rangeメソッドは失敗しました。globalオブジェクトについて
Excel(エクセル)
-
20
ユーザーフォームを表示中にシートの操作をさせるには
Excel(エクセル)
関連するカテゴリからQ&Aを探す
おすすめ情報
このQ&Aを見た人がよく見るQ&A
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
Excel2017 フィルタ昇順並びがA...
-
オートフィルタ後のデータから...
-
エクセルで行の高さ及び列幅の...
-
矩形範囲の複数列を縦1列に並...
-
急ぎ!色のついたセルを非表示...
-
Excelで並び替え後にア行...
-
文字列を比較し、相違するフォ...
-
複数回答のクロス集計の方法
-
エクセル VBA 行間隔を飛ばした...
-
検索条件に合うセルの個数を数...
-
Excelで複数列のデータを1列に...
-
マクロで行の高さを設定したい
-
EXCELで日付を比べ3か月以内の...
-
プルダウンに【なし、平均、デ...
-
エクセルのマクロで別のシート...
-
エクセルの時刻のカウントが出...
-
平均変化率の信頼区間
-
エクセル 複数行ある同一商品...
-
エクセルの集計方法を教えて下さい
-
エクセル関数のSUMPRODUCTにつ...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
Excel2017 フィルタ昇順並びがA...
-
Excelで並び替え後にア行...
-
エクセルで行の高さ及び列幅の...
-
平均変化率の信頼区間
-
急ぎ!色のついたセルを非表示...
-
オートフィルタ後のデータから...
-
【Excel VBA】指定した行の最大...
-
エクセルの時刻のカウントが出...
-
基準日以前のデータを範囲を指...
-
EXCELで日付を比べ3か月以内の...
-
マクロで行の高さを設定したい
-
エクセル関数について
-
文字列を比較し、相違するフォ...
-
エクセル関数について
-
excel / ピポッド 日数を出したい
-
エクセル VBA 行間隔を飛ばした...
-
時間の重複チェック
-
プルダウンに【なし、平均、デ...
-
EXCEL 最終行のデータを他のセ...
-
列と行の名前(重複あり)が交...
おすすめ情報