| |
▼reiko さん：
こんにちは。
>
>B列にプラス、マイナスが入り混じった数値と
>合計値（数式はなし数値のみ）
>が入力されています。
>合計値のすぐ上の行から上にさかのぼって
>合計値と合致するまで足し算をして、
>その数値が入力されている行のみを
>削除したいのですが、
>どうしてもよい方法が思い浮かびません。
>
>どなたかアドバイスいただけないでしょうか？
>表は以下のような感じです。
>
> A B
>1 -500
>2 200
>3 100 ←一品合計から上３行を削除したい
>4 -250 ←
>5 50 ←
>6 一品合計 -100
>7 200
>8 300 ←一品合計から上２行を削除したい
>9 -50 ←
>10一品合計 250
↑この表の合計行ではないＡ列は、例のように未入力セルなのですか？
例題の表では、セルＡ１〜Ａ５、Ａ７〜Ａ９。
というのは、この処理、合計行がどこにあるのかが分かれば、後は、その上の行から
足し算してチェックすればよいですよね（チェックは、ループでも良いし、作業列を
設けて、数式で・・、なんて方法が考えられますが）。
仮に「合計行ではないＡ列は、例のように未入力セル」だとして、
こういう事例だと私は、作業列で何とか・・・と考えてしまう方なのですが・・・。
今回は、ループでやりました。
以下のコードをで確認してみて下さい。
'==============================================
Sub main()
Dim rng As Range
Dim ans As Double
Dim purval As Double
Dim limrow As Long
Dim delrow As Range
Set delrow = Nothing
Set rng = Range("a1", Cells(Rows.Count, 1).End(xlUp))
'↑Ａ列を基準に調査セル範囲を取得
limrow = 1 '足し算を止める行 初期値は、1行目
For idx = 1 To rng.Count 'セルの数だけ繰り返す
If Cells(idx, 1).Value <> "" Then
'↑Ａ列が未入力でないのなら、合計行と見なして・・
purval = Cells(idx, 2).Value '目標値を設定
ans = 0 '足し算の答え格納場所
For jdx = idx - 1 To limrow Step -1 '合計値の上の行からﾘﾐｯﾄ行まで
ans = ans + Cells(jdx, 2).Value '足し算実施
If ans = purval Then '目標値と一致したら？
limrow = idx + 1 '次の足し算を止める行を設定
If Not delrow Is Nothing Then
Set delrow = Union(delrow, Rows((idx - 1) & ":" & jdx))
Else
Set delrow = Rows((idx - 1) & ":" & jdx)
End If
'↑削除する行を設定（削除は、後でまとめて一括削除する）
Exit For
End If
Next jdx
End If
Next idx
If Not delrow Is Nothing Then
delrow.Delete '一括削除
End If
End Sub
処理したいシートをアクティブにして確認してみて下さい。
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
