【お題】引っかけ問題(締め切り10月27日(日)23時)

すみません、初心者です。
添付画像内のファイルを整理したいです。

やりたい事が 4つ あります。

まず、B列の伝票番号を上から見ていき、
① 伝票内(伝票No:1ですとA4からL8まで)に”0”がなかったら削除したい
  図内ですと削除伝票は3、7、14、18です

② 伝票No:2ですと、”G9”の売値を”G10”に入力(コピー)
  ”G11”の売値を”G12”に入力

③ 伝票No:11の場合は”I24”の送料を”I23”に合算
  ※伝票No:25も同様です

④ 伝票No:40は"I31”と”I32”の合計を”I30”に入力


たくさん書いてしまいましたが一つだけでも教えていただけると
助かります。
説明不足な点などありましたらご指摘ください。
お分かりの方、いらっしゃいましたらよろしくお願いします。

「マクロ 同じ行番号をグループとして、条件」の質問画像

質問者からの補足コメント

  • HAPPY

    soixanteさんへ

    早々の回答ありがとうございました!
    削除できました!びっくりしました(^^;
    確認すると消したいものは消えるのですが、最後にエラー?
    『実行時エラー 1004 アプリケーション定義…』と出るのですが
    問題はありませんか?


    ②から④についてはおっしゃる通り行数や並びもまちまちです。

    そこで、残った伝票については、上か下に1行追加してそこに
    売値計と仕入計の合計を入れる事はできますでしょうか?
    例えば伝票No2については9行目か18行目に1行追加して、
    そこに『141,410』と『116,590』(見えづらいかもしれませんが合計です)
    を入力

    伝票ごとの合計がわかれば資料としては何とかなりそうですので。

    お願いばかりですみませんが、よろしければご検討をお願いします。

    No.1の回答に寄せられた補足コメントです。 補足日時:2015/07/05 08:07

A 回答 (3件)

#2です。



>コードの順序を変えるとエラーになってしまいますが、どこかを変更すればできますでしょうか?

VBAの知識があれば可能です。ただ、一連の流れがありますので、単純に順番入れ替えだけではできません。

「いったん目を通してから削除させたい」とのことなので、コード自体を二つに割りました。
① まず、それぞれの伝票番号のグループごとのまとめ行を作成する ・・・ Sub xxx01
で、これに一旦目を通してから、次のコードを実行する
② G~J列の値に0がない伝票番号のグループを、まとめ行も含めてすべて削除 ・・・Sub xxx02
つまり、2回コードを実行することとなります。

-------------------------------------------------------------------------

Sub xxx01() '伝票番号ごとにまとめ行を入れる
Dim r As Long, p As Long
Dim Lstrow As Long, Dnum As Integer
Dim Strow As Long, Edrow As Long
Dim WSF As Object

Set WSF = Application.WorksheetFunction
Lstrow = Cells(Rows.Count, 2).End(xlUp).Row
r = Lstrow

Do Until r = 4
Dnum = Cells(r, 2).Value '伝票NOを格納
Edrow = r 'その伝票No範囲の最終行
p = r
Do Until Dnum <> Cells(p, 2).Value
p = p - 1
Loop
Strow = p + 1 'その伝票NO範囲の開始行

Rows(Strow).Insert 'まとめ行挿入

Cells(Strow, 2).Value = Dnum
Cells(Strow, 3).Value = "計"
Cells(Strow, 8).Value = WSF.Sum(Range(Cells(Strow, 8), Cells(Edrow + 1, 8))) '売上計
Cells(Strow, 10).Value = WSF.Sum(Range(Cells(Strow, 10), Cells(Edrow + 1, 10))) '仕入計

'まとめ行に着色
Range(Cells(Strow, 1), Cells(Strow, 12)).Interior.ColorIndex = 35
r = Strow - 1 '次の伝票Noの行へ
Loop

Set WSF = Nothing
MsgBox "まとめ行作成完了"
End Sub

Sub xxx02() '伝票番号ごとのグループG~J列に0が無い場合はその伝票番号グループを削除

Dim r As Long, p As Long
Dim Lstrow As Long, Strow As Long, Edrow As Long
Dim WSF As Object
Dim Rng As Range, Sel As Range, Flg As Boolean

Flg = True
Set WSF = Application.WorksheetFunction

'最終行取得
Lstrow = Cells(Rows.Count, 2).End(xlUp).Row
r = Lstrow

'最終行から上へループ
Do Until r = 4
Edrow = r 'その伝票Noの範囲の最終行
p = Edrow
Do Until Cells(p, 3).Value = "計"
p = p - 1
Loop
Strow = p + 1 'その伝票Noの範囲の開始行
Set Rng = Range(Cells(Strow, 7), Cells(Edrow, 10)) '変数RngにG~J列をセット
For Each Sel In Rng 'その範囲内に0があったらFlgをFalseに
If Sel.Value = 0 Then
Flg = False
Exit For
End If
Next Sel
If Flg = True Then 'FlgがTrueならその伝票範囲を行ごとカット
Range(Rows(Strow - 1), Rows(Edrow)).Delete
End If
Flg = True
r = Strow - 2 '次の伝票Noの行へ
Loop
Set WSF = Nothing
MsgBox "不要伝票番号グループ削除完了"
End Sub

-------------------------------------------------------------------------
いかがでしょう?
    • good
    • 0
この回答へのお礼

soixanteさん

確認から削除まで全てできました。
何からなにまで丁寧に教えていただき、助かりました。

これをもとに明日社内で話をしてきます。
またわからない事が出てきましたら改めて新規に質問させて頂きます。

その際はまたよろしくお願いします。
本日は何度もありがとうございました。

お礼日時:2015/07/05 21:11

#1です。

補足拝見しました。

>残った伝票については、上か下に1行追加してそこに売値計と仕入計の合計を入れる事はできますでしょうか?

「売値計」というのは、H列の「売上」の合計ということでしょうか。
「仕入計」は、J列だと認識して以下で対応してみました。
バックアップは取ったうえで以下をお試しください。

前回のコード分(①の作業)も入っているので、そっくりそのままこれをコピペで使ってください。
不要な伝票番号をカットして、さらにそのあと、残った伝票番号のまとめを、その伝票範囲の上に挿入する、
というコードです。

------------------------------------------------------------------
Sub yyy()
Dim r As Long, p As Long
Dim Lstrow As Long, Dnum As Integer
Dim Strow As Long, Edrow As Long
Dim Rng As Range, Sel As Range, Flg As Boolean
Dim WSF As Object

Flg = True
Set WSF = Application.WorksheetFunction

'最終行取得
Lstrow = Cells(Rows.Count, 2).End(xlUp).Row
r = Lstrow

'最終行から上へループ
Do Until r = 4
Dnum = Cells(r, 2).Value '伝票Noを格納
Edrow = r 'その伝票Noの範囲の最終行
p = Edrow
Do Until Dnum <> Cells(p, 2).Value
p = p - 1
Loop
Strow = p + 1 'その伝票Noの範囲の開始行
Set Rng = Range(Cells(Strow, 7), Cells(Edrow, 10)) '変数RngにG~J列をセット
For Each Sel In Rng 'その範囲内に0があったらFlgをFalseに
If Sel.Value = 0 Then
Flg = False
Exit For
End If
Next Sel
If Flg = True Then 'FlgがTrueならその伝票範囲を行ごとカット
Range(Rows(Strow), Rows(Edrow)).Delete
End If
Flg = True
r = Strow - 1 '次の伝票Noの行へ
Loop

'残った伝票番号ごとにまとめ行を入れる
Lstrow = Cells(Rows.Count, 2).End(xlUp).Row
r = Lstrow

Do Until r = 4
Dnum = Cells(r, 2).Value '伝票NOを格納
Edrow = r 'その伝票No範囲の最終行
p = r
Do Until Dnum <> Cells(p, 2).Value
p = p - 1
Loop
Strow = p + 1 'その伝票NO範囲の開始行

Rows(Strow).Insert 'まとめ行挿入

Cells(Strow, 2).Value = Dnum
Cells(Strow, 3).Value = "計"
Cells(Strow, 8).Value = WSF.Sum(Range(Cells(Strow, 8), Cells(Edrow + 1, 8))) '売上計
Cells(Strow, 10).Value = WSF.Sum(Range(Cells(Strow, 10), Cells(Edrow + 1, 10))) '仕入計

'まとめ行に着色
Range(Cells(Strow, 1), Cells(Strow, 12)).Interior.ColorIndex = 35
r = Strow - 1 '次の伝票Noの行へ
Loop

MsgBox "完了"
End Sub
------------------------------------------------------------------

まとめ行は分かりやすく色を塗ってみました。
もしその必要がないならば、以下の一行を削除してください。
 ここ↓

'まとめ行に着色
Range(Cells(Strow, 1), Cells(Strow, 12)).Interior.ColorIndex = 35

色を変えたいならば、35 を適宜変更してください。


実行時エラー1004の原因についてはちょっと分かりかねます。私の手元のダミー版では出ないんですよ(汗
何か書き換えたりされてますかね?
ここのSample6にこのエラーの説明があります。
http://officetanaka.net/excel/vba/error/executio …


どうでしょう。ご意向にそぐっていますか。ご不明点はお知らせください m(_ _)m
    • good
    • 0
この回答へのお礼

soixanteさん
またまたこんなに長いプログラム(コードですか?)を短時間で対応いただきまして
ありがとうございます。合計がでました!(合計の範囲もあっています)

エラーはでてしまうのですが、合計が出た後なので特に問題なさそうです。

ちなみに、先に合計を追加して、いったん目を通してから削除させたいのですが、
コードの順序を変えるとエラーになってしまいますが、どこかを変更すればできますでしょうか?

何度もすみませんがご教授いただけると助かります。
お手数かけますが、よろしくお願いします。

お礼日時:2015/07/05 11:31

★削除後は戻せませんので必ずバックアップを取ってから試してください★




① 例示されている図からすると、0があるかどうかを判定するのは、G~J列と言うことでよいですか。
  0に水色が塗ってあるので。
  そういうことなら以下。
----------------------------------------------------
Sub zzz()
Dim r As Long, p As Long
Dim Lstrow As Long, Dnum As Integer
Dim Strow As Long, Edrow As Long
Dim Rng As Range, Sel As Range, Flg As Boolean
Flg = True

'最終行取得
Lstrow = Cells(Rows.Count, 2).End(xlUp).Row
r = Lstrow

'最終行から上へループ
Do Until r = 4
Dnum = Cells(r, 2).Value '伝票Noを格納
Edrow = r 'その伝票Noの範囲の最終行
p = Edrow
Do Until Dnum <> Cells(p, 2).Value
p = p - 1
Loop
Strow = p + 1 'その伝票Noの範囲の開始行
Set Rng = Range(Cells(Strow, 7), Cells(Edrow, 10)) '変数RngにG~J列をセット
For Each Sel In Rng 'その範囲内に0があったらFlgをFalseに
If Sel.Value = 0 Then
Flg = False
Exit For
End If
Next Sel
If Flg = True Then 'FlgがTrueならその伝票範囲を行ごとカット
Range(Rows(Strow), Rows(Edrow)).Delete
End If
Flg = True
r = Strow - 1 '次の伝票Noの行へ
Loop

End Sub
----------------------------------------------------


②~④についてですが、書かれていることをそのままやるだけならいいのですが、

(たとえば、「”G9”の売値を”G10”に入力(コピー)」なら、Cells("G10").Value=Cells("G9").Value とか)

そうじゃないですよね? 何かしら規則性や法則があるのでしょう。
①からの流れから続くものならば、行番号も変わっているはずなので①だけの回答といたします。
この回答への補足あり
    • good
    • 0
この回答へのお礼

夜中に対応いただきましてありがとうございました。
急いで回答頂いたのにお礼が遅くなりましてすみません。
削除はできました!
プログラムを見てもなかなか理解ができませんが頑張ってみます(^^;

すこし質問内容が変わってしまうのですが、補足説明に記載しましたので
ご確認いただけますでしょうか。
また、不明点や不備がありましたらご指摘ください。
よろしくお願いします。

お礼日時:2015/07/05 08:14

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!


おすすめ情報