エクセルマクロでセルの数字を処理

質問

エクセルのマクロで以下の処理をしたいのですが、少し複雑でうまく出来ません。できればどのようなマクロを用いればよいか教えてください。

A列に数字がならんでいます。

1、A１から順番に下方向にこの数字を調べます。

2、100未満の場合はそのまま下に移動します。

3、セルの数字が100を超えていたら、100を超えていたセルを起点（1番目）として、下方向にセルの数字を調べ、起点となるセルの数字より10％以上多いセルが見つかれば、それと起点のセルとの差を調べ、見つからなければ起点のセルと30番目のセルとの差を調べます。

4、3の処理が終わったら、再び起点となったセルから1つ下に移動してA列の数字を調べ、100以上なら、再び3からの処理を繰り返します。
調べるA列のセルより下のセルが30個より少なければ終了です。

3で調べた数字の総和を求めるのが目的です。

よろしくお願いします。

回答No.3

Randomize · ベストアンサー

マクロだけですと、以下のようになります。
---------------------------ここから----------------------------
Public Sub DoCalc()
Dim varRangeData() As Variant, NowReadRow As Long, NowScanRow As Long, MaxReadRow As Long, MaxScanRow As Long
Dim dblResult As Double '<=整数しか扱わない場合はDoubleをLongに変更してください。
With ThisWorkbook.Sheets("Sheet1")
Application.StatusBar = "現在データをメモリーに格納中です..."
varRangeData = .Range(.Range("A1"), .Cells(.Cells(.Rows.Count, 1).End(xlUp).Row, 1)).Value
MaxReadRow = UBound(varRangeData, 1)
If MaxReadRow < 30 Then
MsgBox "データの数が30個無いため処理を中断します。", vbOKOnly Or vbExclamation, "エラー"
Application.StatusBar = False
Exit Sub
End If
dblResult = 0
MaxReadRow = MaxReadRow - 30
For NowReadRow = 1 To MaxReadRow
Application.StatusBar = "現在" & CStr(NowReadRow) & "/" & CStr(MaxReadRow) & "行目の内容を読み取り中です..."
If varRangeData(NowReadRow, 1) >= 100 Then
MaxScanRow = NowReadRow + 29 'わざと1少ない値にしてください
For NowScanRow = NowReadRow To MaxScanRow
If varRangeData(NowScanRow, 1) >= varRangeData(NowReadRow, 1) * 1.1 Then
'110％を超えている行が見つかったらループを抜けることにより
'NowScanRowは該当行の値になります。
'29個先まで見つからなかった場合はNowScanRowは30になってこのループを終了します。
Exit For
End If
Next
'該当セルまたは30個先のセルとの差をdblResultに加算する
dblResult = dblResult + varRangeData(NowScanRow, 1) - varRangeData(NowReadRow, 1)
End If
Next
Application.StatusBar = False
MsgBox "結果は" & vbCrLf & CStr(dblResult) & vbCrLf & "でした。", vbOKOnly Or vbInformation, "計算結果"
'セルに書き込みたい場合は下の1行を編集してください。
'.Range("B1").Value = dblResult
End With
End Sub
---------------------------ここまで----------------------------
なお、本マクロでは以下の3点を勝手に推測しています。
1)基点より下へ30個スキャンしますが、30個までに該当数字が複数見つかった場合、一番初めに見つかった数字のみ差を求めます。
2)A列に入力されている数字は小数点以下を含む数字が混じっていることを想定しています。
それなりに高速に動作するマクロであると思っております。
3)差を求めると書かれていますが、差の順序を(該当数字)-(基点の数字)にしています

なお、2)と3)はマクロを理解できるのであれば容易に修正できると思いますので、用途に合わせて修正してあげてください。

質問で「マクロが複雑でうまくできません。」とありますが、その下にうまく箇条書きでまとめられておられますよね。マクロはその箇条書きのとおりにコンピューター用の言葉で書いてあげているだけです。
マクロの動作をよく見てみて今後のステップアップの糧になれば幸いです。
また、動作原理としては下の参考URLの仕組みを利用しています。参考にしてください。

参考URL：

http://officetanaka.net/excel/vba/speed/s11.htm

お礼

とてもご丁寧な解説ありがとうございました。
マクロの内容を見ていくととても勉強になります。

回答No.4

imogasi

複雑な課題で、質問文が長いが、
フローチャートを丁寧に作れば、何も難しいことはないのでは。
丸投げして、自分で手をつけてないのでは。質問規約違反。
ある投げでも回答してくれる親切な人はいるが。
ーーー
IF文を使って
１つずつA列セルを検査していけばしまいでしょう。行をさすポインタ変数を考える。基点行と現在チェックしている行との２つ。
　　１００を超えているか
　　基点の数の１１０％以上か
＞見つからなければ起点のセルと30番目のセルとの差を調べます。
と＞セルから1つ下に移動してA列の数字を調べ
は同じ事を言っているのでは。
フローチャートも描かないでコードがどうなるかと言ってないですか。

お礼

ありがとうございます。
初心者のため、どのように手をつければよいかわかりませんでした。
これからいろいろ勉強します。

回答No.2

merlionXX

こういうことかな？

Sub test01()
Dim lstRw As Long, x As Long, i As Long, n As Long
Dim buf As Boolean
With ActiveSheet
lstRw = .Cells(Rows.Count, "A").End(xlUp).Row ' 最終行取得
For i = 1 To lstRw - 29 '1行目から最終行の29行前までを調査
If .Cells(i, "A").Value > 100 Then '100を超えていたら
buf = False
For n = i + 1 To lstRw 'その一つ下の行から最終行まで
If .Cells(n, "A").Value > .Cells(i, "A").Value * 1.1 Then '10％超の最初のセルを検索
x = x + .Cells(n, "A").Value - .Cells(i, "A").Value 'あったら差額をｘに加算
buf = True
Exit For '繰り返しを抜ける
End If
Next n '繰り返し
If buf = False Then '10％超がなかったら
x = x + .Cells(i + 29, "A").Value - .Cells(i, "A").Value '30番目との差額をxに加算
End If
End If
Next i
End With
MsgBox "差額の和は、" & x
End Sub

お礼

うまくできそうです。ありがとうございました。

回答No.1

ASIMOV

＞3、セルの数字が100を超えていたら、100を超えていたセルを起点（1番目）として、下方向にセルの数字を調べ、起点となるセルの数字より10％以上多いセルが見つかれば、それと起点のセルとの差を調べ、見つからなければ起点のセルと30番目のセルとの差を調べます

疑問が
１．「10％以上多いセルが見つかれば」何をするのか？
２．複数見つかった場合は？
３．３０番目まで調べて対象がなっかたばあいに「４」に移るという事か？

補足

１、10％以上多いセルが見つかったときには、起点になったセルとそのセルとの数字の差をもとめます。（この差をAとします。）

２、上から順番に調べていくので、最初に見つかったセルのみ対象にします。10％以上多いセルが見つかったら、上記処理を行った後「４」に移ります。

３、30番目まで調べて対象がなければ、起点になったセルと30番目のセルの数字の差をもとめた後「４」に移ります。（この差をBとします。）

最終的な目的は、AとBの総和を求めることです。
分かりにくい表現で恐縮ですが、よろしくお願いいたします。必要があればまた補足いたします。