VBAの値引き渡し処理に関して、教えて下さい。

質問

すいません。
VBAを勉強中の者です。
あるシステムの開発を会社で命じられ、VBAで必死に構築しております。
いくつかの問題は、自己解決したのですが、下記の部分が、どう調べても分かりません。
教えて下さい。
よろしくお願いいたします。

＝＝＝＝＝＝＝＝＝＝＝
＜説明＞
添付の様なエクセルシートがあります。（実際は、もっと行数も列数も多いですが。）
点数が一番高い会社（この例では、C社）のみのデータ行のみを抽出して、それ以外の行を消したいと考えております。

シート名を、ranking とすると、とりあえず、下記の様なコードにて、最大値を求めると思います。

*************
Public Sub ranking_ope()

'高順位を選択。

Sheets("ranking").Select
Dim maxVal As Long

'Excelのワークシート関数を使う
With Application.WorksheetFunction

'E列に記入された数値の最大値を求める
maxVal = .Max(Range("D:D"))

End With
End Sub
**************************
上記の動作を確認しましたが、ここまでは、OKです。

＜質問＞
お聞きしたいのは、この先です。
D列で、maxValの値を持っている会社（この場合はC社）以外の行を消したいと考えております。
申し訳ないのですが、コードと一緒に教えて下さい。

思うに、別のプロシージャーを作成して、そこに、maxValを「値引き渡し」で引き継いで、D列の値が、maxVal以外の場合は、削除すると言う事にすると思うのですが、どうも「値引き渡し」が出来ていない様です。

よろしくお願いいたします。

回答No.4

SI299792 · ベストアンサー

１．その通りです。受け渡す変数が複数ある時は、「，」で区切ります。長くなるようなら、「＿」で次の行に書きます。
　勉強のために、値引き渡しの方法が知りたいのであって、動けば何でもいいわけではないのですね。

２．ごめんなさい。読み間違えました。お書きの通り、
　　If Cells(Row, "D") <> maxVal Then
に直してもいいし、
　　If Cells(Row, "D") < maxVal Then
にしてもいいです。

後、最終行を得るやり方も、必要となります。私は、
　　RowEnd = [D4].End(xlDown).Row
としました。簡単なので、私は愛用していますが、データが無いと誤動作する。途中に空白があるとそこで止まるという弱点があります（その弱点を利用して、空白後に別の表がある時に使えます）。データが無い、空白データの可能性がある場合、他の人がやった
　　RowEnd = Range(Rows.Count, "D").End(xlUp).Row
を使います。

受け渡し変数が２つある事例です。
'
Sub Macro4()
'
　　Dim RowEnd As Long
　　Dim maxVal As Long
　　Dim Row As Long
'
　　Sheets("ranking").Select
　　RowEnd = [D4].End(xlDown).Row
'
　　ranking_ope2 RowEnd, maxVal
'
　　For Row = RowEnd To 5 Step -1
'
　　　　If Cells(Row, "D") < maxVal Then
　　　　　　Rows(Row).Delete
　　　　End If
　　Next Row
End Sub
'
Public Sub ranking_ope2(RowEnd As Long, _
　　　　　　　　　　　　maxVal As Long)
'
　　Dim DRange As Range
'高順位を選択。
　　Set DRange = Range("D4:D" & RowEnd)
　　maxVal = WorksheetFunction.Max(DRange)
End Sub

お礼

御礼が遅くなり失礼しました。
（ベストアンサーを選んだ際に、お礼のメッセージも書いたのですが、反映されなかった様です。。。）
本件、解決いたしました。
ありがとうございました。

回答No.3

imogasi

質問の趣旨と違うと思うが
例データ
社名 住所 点数
A 東京 70
B 神奈川 65
C 北海道 80
D 埼玉 52
E 大阪 35
F 奈良 80
最後１行追加した。
データーフィルターのTOP1を抽出の操作をして、マクロの記録。
Sub Macro1()
'
' Macro1 Macro
'
Range("A1:C7").Select
Selection.AutoFilter
ActiveSheet.Range("$A$1:$C$7").AutoFilter Field:=3, Criteria1:="1", _
Operator:=xlTop10Items
End Sub
ーー
結果
社名 住所 点数
C 北海道 80
F 奈良 80
難しいことを考えるよりこういう方法を生かしては。
＝＝
初歩的で素直な方法は、点数列の最大値を求める。
最下行から、ForNextで上行方向に最大値かどうかIFで判定し、同じ値以外の行は行削除するとか。
言いたいことは、（自分の最初の思い付きを置いておいて、折角多数の人に聞くのだから）大切なのは、他人のよさそうなやり方の探求と真似だと思う。

回答No.2

SI299792

Sub の中にDim で変数を書いても、そのサブルーチン専用変数で、他に渡すことはできません。()に受け渡しの変数を宣言する必要があります。
'
Option Explicit
'
Sub Macro1()
'
　　Dim maxVal As Long
　　Dim Row As Long
'
　　ranking_ope maxVal
'
　　For Row = [D4].End(xlDown) To 5 Step -1
'
　　　　If Cells(Row, "D") = maxVal Then
　　　　　　Rows(Row).Delete
　　　　End If
　　Next Row
End Sub
'
Public Sub ranking_ope(maxVal As Long)
'　Dim maxVal As Long は消しておく

又は、関数にします。
'
Sub Macro2()
'
　　Dim maxVal As Long
　　Dim Row As Long
'
　　maxVal = Ranking
'
　　For Row = [D4].End(xlDown) To 5 Step -1
'
　　　　If Cells(Row, "D") = maxVal Then
　　　　　　Rows(Row).Delete
　　　　End If
　　Next Row
End Sub
'
Function Ranking() As Long
'
　　Sheets("ranking").Select
　　Ranking = WorksheetFunction.Max(Range("D:D"))
End Function
’
グローバル変数にするという方法もありますが、お勧めできない方法なので割愛します。

ただ、プロシージャーを別にする必要はないと思います。１本で済みます。
それど、Ｄ列全てを見ているので、時間がかかります。こうすれば速くなります。
'
Sub Macro3()
'
　　Dim RowEnd As Long
　　Dim maxVal As Long
　　Dim DRange As Range
　　Dim Row As Long
'
　　Sheets("ranking").Select
　　RowEnd = [D4].End(xlDown).Row
　　Set DRange = Range("D4:D" & RowEnd)
　　maxVal = WorksheetFunction.Max(DRange)
'
　　For Row = RowEnd To 5 Step -1
'
　　　　If Cells(Row, "D") = maxVal Then
　　　　　　Rows(Row).Delete
　　　　End If
　　Next Row
End Sub

補足

早速のご回答を誠にありがとうございます。
解釈しながら、試しております。
大変、勉強になります。

検証まで、もうしばらく時間が掛かりそうなのですが、
２点だけ確認をさせて下さい。

１．

＞　()に受け渡しの変数を宣言する必要があります。

「受け渡しの変数を宣言」は、下記で行っていると言う理解で宜しいでしょうか？

＞　Public Sub ranking_ope(maxVal As Long)

２．

＞If Cells(Row, "D") = maxVal Then
＞Rows(Row).Delete

Macro1()に上記記載がありますが、今回は、最高得点以外は行削除すると言う風にしたいので、下記の様になりませんか？　（イコールではなく。）
＝＝＝＝＝＝＝＝＝
If Cells(Row, "D") <> maxVal Then
Rows(Row).Delete
＝＝＝＝＝＝＝＝

よく分かっておらず、質問ばかりで申し訳ございませんが、教えて下さい。
よろしくお願いいたします。

回答No.1

mt2015

サンプルです。
D列の値が80未満の行をデータが入っている一番下の行から5行目まで順番に探し、削除します。
列を削除する場合、下から探していって削除がコツです（検索範囲が変わらないため）。

Sub main()
　　maxVal = 80
　　MsgBox fDel(maxVal) & "行削除"
End Sub
Function fDel(nMax) As Long
　　For nRow = Cells(Rows.Count, 4).End(xlUp).Row To 5 Step -1
　　　　If Cells(nRow, 4) < nMax Then
　　　　　　Rows(nRow).Delete Shift:=xlUp
　　　　　　fDel = fDel + 1
　　　　End If
　　Next nRow
End Function