Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


10888 / 13644 ツリー ←次へ | 前へ→

【19367】合計と一致する行を削除するには reiko 04/10/29(金) 13:45 質問[未読]
【19374】Re:合計と一致する行を削除するには ichinose 04/10/29(金) 15:43 発言[未読]
【19375】Re:合計と一致する行を削除するには IROC 04/10/29(金) 15:44 回答[未読]

【19367】合計と一致する行を削除するには
質問  reiko  - 04/10/29(金) 13:45 -

引用なし
パスワード
   こんにちは。

B列にプラス、マイナスが入り混じった数値と
合計値(数式はなし数値のみ)
が入力されています。
合計値のすぐ上の行から上にさかのぼって
合計値と合致するまで足し算をして、
その数値が入力されている行のみを
削除したいのですが、
どうしてもよい方法が思い浮かびません。

どなたかアドバイスいただけないでしょうか?
表は以下のような感じです。

   A     B
1       -500
2        200
3        100  ←一品合計から上3行を削除したい
4        -250  ←
5        50  ←
6 一品合計  -100  
7        200
8       300  ←一品合計から上2行を削除したい
9        -50  ←
10一品合計  250

【19374】Re:合計と一致する行を削除するには
発言  ichinose  - 04/10/29(金) 15:43 -

引用なし
パスワード
   ▼reiko さん:
こんにちは。

>
>B列にプラス、マイナスが入り混じった数値と
>合計値(数式はなし数値のみ)
>が入力されています。
>合計値のすぐ上の行から上にさかのぼって
>合計値と合致するまで足し算をして、
>その数値が入力されている行のみを
>削除したいのですが、
>どうしてもよい方法が思い浮かびません。
>
>どなたかアドバイスいただけないでしょうか?
>表は以下のような感じです。
>
>   A     B
>1       -500
>2        200
>3        100  ←一品合計から上3行を削除したい
>4        -250  ←
>5        50  ←
>6 一品合計  -100  
>7        200
>8       300  ←一品合計から上2行を削除したい
>9        -50  ←
>10一品合計  250
↑この表の合計行ではないA列は、例のように未入力セルなのですか?
例題の表では、セルA1〜A5、A7〜A9。

というのは、この処理、合計行がどこにあるのかが分かれば、後は、その上の行から
足し算してチェックすればよいですよね(チェックは、ループでも良いし、作業列を
設けて、数式で・・、なんて方法が考えられますが)。

仮に「合計行ではないA列は、例のように未入力セル」だとして、
こういう事例だと私は、作業列で何とか・・・と考えてしまう方なのですが・・・。
今回は、ループでやりました。

以下のコードをで確認してみて下さい。

'==============================================
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))
  '↑A列を基準に調査セル範囲を取得
  limrow = 1 '足し算を止める行 初期値は、1行目
  For idx = 1 To rng.Count 'セルの数だけ繰り返す
   If Cells(idx, 1).Value <> "" Then
   '↑A列が未入力でないのなら、合計行と見なして・・
     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

処理したいシートをアクティブにして確認してみて下さい。

【19375】Re:合計と一致する行を削除するには
回答  IROC  - 04/10/29(金) 15:44 -

引用なし
パスワード
   雰囲気としてはこのような方法でできると思います。
思いつきで直接書いたので、参考ということでお願いします。

dim i as long
dim myTotal as long
dim cnt as long

for i = 100 to 1 step -1
  if cells(i,1).value = "一品合計" then
    myTotal = cells(i,2).value    
    cnt = 0
  end if

  cnt = cnt + cells(i,2).value

  if myTotal = cnt then
   cnt=0 
   rows(i).delete
  end if
next i

10888 / 13644 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free