こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

解決済みの質問

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以外の場合は、削除すると言う事にすると思うのですが、どうも「値引き渡し」が出来ていない様です。

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

投稿日時 - 2018-03-26 14:52:01

QNo.9481898

すぐに回答ほしいです

質問者が選んだベストアンサー

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

2.ごめんなさい。読み間違えました。お書きの通り、
  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
を使います。

受け渡し変数が2つある事例です。
'
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

投稿日時 - 2018-03-27 03:32:31

お礼

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

投稿日時 - 2018-03-31 12:06:22

このQ&Aは役に立ちましたか?

0人が「このQ&Aが役に立った」と投票しています

回答(4)

ANo.3

質問の趣旨と違うと思うが
例データ
社名住所点数
A東京70
B神奈川65
C北海道80
D埼玉52
E大阪35
F奈良80
最後1行追加した。
データーフィルターの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で判定し、同じ値以外の行は行削除するとか。
言いたいことは、(自分の最初の思い付きを置いておいて、折角多数の人に聞くのだから)大切なのは、他人のよさそうなやり方の探求と真似だと思う。

投稿日時 - 2018-03-26 19:24:57

ANo.2

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

グローバル変数にするという方法もありますが、お勧めできない方法なので割愛します。

ただ、プロシージャーを別にする必要はないと思います。1本で済みます。
それど、D列全てを見ているので、時間がかかります。こうすれば速くなります。
'
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

投稿日時 - 2018-03-26 16:29:13

補足

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

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

1.

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

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

> Public Sub ranking_ope(maxVal As Long)



2.

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

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

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

投稿日時 - 2018-03-26 17:58:31

ANo.1

サンプルです。
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

投稿日時 - 2018-03-26 16:22:04

あなたにオススメの質問