| |
こんなのでは
Option Explicit
Public Sub Sample_1()
Dim i As Long
Dim lngRows As Long
Dim rngList As Range
Dim a() As Variant
Dim vntData() As Variant
Dim vntResult As Variant
Dim vntStart As Variant
Dim vntEnd As Variant
Dim strProm As String
'Listの先頭セル位置を基準とする（先頭列の列見出しのセル位置）
Set rngList = ActiveSheet.Range("A1")
With rngList
'行数の取得
lngRows = .Offset(Rows.Count - .Row).End(xlUp).Row - .Row
If lngRows <= 0 Then
strProm = "データが有りません"
GoTo Wayout
End If
'A、B列データを配列に取得
vntData = .Offset(1).Resize(lngRows, 2).Value
'数量×重量の配列を確保
ReDim a(.Row + 1 To .Row + lngRows)
'数量×重量を計算
For i = 1 To lngRows
a(i + .Row) = vntData(i, 1) * vntData(i, 2)
Next i
End With
'集計開始行取得
vntStart = Application.InputBox(Prompt:="集計開始行を入力して下さい", _
Default:=LBound(a), Type:=1)
If VarType(vntStart) = vbBoolean Then
strProm = "マクロがキャンセルされました"
GoTo Wayout
Else
'集計開始行が範囲外なら
If vntStart < LBound(a) Or UBound(a) < vntStart Then
strProm = "集計開始行が範囲から外れて居ます"
GoTo Wayout
End If
End If
'集計終了行取得
vntEnd = Application.InputBox(Prompt:="集計終了行行を入力して下さい", _
Default:=UBound(a), Type:=1)
If VarType(vntEnd) = vbBoolean Then
strProm = "マクロがキャンセルされました"
GoTo Wayout
Else
'集計終了行が範囲外なら
If vntEnd < LBound(a) Or UBound(a) < vntEnd Then
strProm = "集計終了行が範囲から外れて居ます"
GoTo Wayout
End If
End If
'開始行が終了行より大きかったら
If vntStart > vntEnd Then
strProm = "'開始行が終了行より大ので集計出来ません"
GoTo Wayout
End If
'Key列に就いて繰り返し
For i = vntStart To vntEnd
vntResult = vntResult + a(i)
Next i
strProm = "集計結果は、" & vntResult
Wayout:
Set rngList = Nothing
MsgBox strProm, vbInformation
End Sub
|
|
Hirofumi
- 10/11/12(金) 20:33 -
