Excel VBA アクティブセルからある一定のセルまでの範囲選択

Excel VBA　アクティブセルからある一定のセルまでの範囲選択

Excel2003を使用しています。
アクティブセルからC列に『計』と入力されている行の1行上のD列までを選択状態にするマクロを作成しようとしています。

C列に『計』と入力されている行は下記のように複数あるので、アクティブセルの行以下に入力されている次のC列の『計』の1行上までとしたいのですが、どのようにコードを書いたらいいでしょうか？
例えば…
A2セルをアクティブにしていてマクロを実行するとA2：D3が選択状態に
A7セルをアクティブにしていてマクロを実行すると、A7：D9が選択状態になるように
という具合です。

わかりづらくて申し訳ありませんが、よろしくお願いします。

　　　A　　　　　B　　　　　C　　　　　D
1　　日付　　　 №　　　品名　　　 金額
2　　1/1　 　　　1　 　　○○○　　 1,000
3　　1/2　 　　　2　 　　×××　　 1,500
4 　　　　　　　　　　　　　計 　　　　 2,500
5
6
7 　　1/1 　　　 5 　　　○×○　　 2,000
8 　　1/3 　　　 6 　　　××○　　 1,200
9 　　1/4 　　　 7 　　　×○○　　 2,500
　　　　　　　　　　　　　　計 　　　　 5,700

　　　　　　　　　　　：
　　　　　　　　　　　：

No.3 回答者： Wendy02 回答日時： 2010/01/18 18:33

こんにちは。

単にユーティリティ範囲に留まります。たぶん、この後で罫線を引きたいというようなことを考えているのではないかと思います。

以下のTest1 マクロで、ActiveCell は、データのある範囲なら、どこでも良いです。

なお、Cells(1).Text　ここは、.Value では判定できません。

'-------------------------------------------
Sub Test1()
　　Dim i As Long
　　Dim j As Long
　　With ActiveCell.CurrentRegion
　　If ActiveCell.Value = "" Then Exit Sub
　　　　'タイトルがある場合
　　　　If IsDate(.Cells(1).Text) = False Then
　　　　　　i = 1
　　　　End If
　　　　'範囲の最後の手前に'計'という文字があるか判定
　　　　If .Cells(.Cells.Count).Offset(, -1).Value Like "*計*" Then
　　　　　　j = -1
　　　　End If
　　　　ActiveSheet.Range(.Cells(1).Offset(i), .Cells(.Count).Offset(j)).Select
　　End With
End Sub
'-------------------------------------------

この回答へのお礼

Wendy02 さま
お礼が遅くなり申し訳ありません。

マクロ実行後は選択された範囲内で並べ替えをしたく、“計”までのデータ(行)が多くなるときもあることから、アクティブセル以下、“計”の1行上までの範囲を自動的に選択できればと思い、質問させていただいた次第です。

今回は記載していただいたように、CurrentRegion プロパティを使用する方法でいきたいと思います。
ご回答ありがとうございました。

お礼日時：2010/01/20 15:48

No.2 ベストアンサー 回答者： watabe007 回答日時： 2010/01/18 16:37

E列にはデータが無い

D列には必ず"計"がある
"計"の有る行のひとつ下の行にはデータが無い
などの条件が揃うなら
With ActiveCell.CurrentRegion
　　.Resize(.Rows.Count - 1).Select
End With

この回答へのお礼

watabe007 さま
お礼が遅くなり申し訳ありません。

記載していただいたコードにひとつ条件を追加し、CurrentRegion プロパティを使用する方法で、希望通り動作しました。

ご回答ありがとうございました。

お礼日時：2010/01/20 15:34

No.1 回答者： KURUMITO 回答日時： 2010/01/18 15:24

例えば次のようなコードにします。

Sub 範囲選択()
Dim RowP As Integer
Dim rp As Integer
RowP = ActiveCell.Row
rp = WorksheetFunction.Match("計", Range(Range("C" & RowP), Range("C1000")), 0) + RowP
Range(Range("A" & RowP), Range("D" & rp - 2)).Select
End Sub

この回答へのお礼

KURUMITO さま
お礼が遅くなり申し訳ありません。

質問文をそのまま記述したようなコードで、VBA勉強中の私にとって、理解しやすかったです。
ご回答ありがとうございました。

お礼日時：2010/01/20 15:21