[[20150304223256]] 『転記用マクロの改変について』(maki) ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『転記用マクロの改変について』(maki)

以前、こちらでお力添えいただき、下記のようなマクロをご教示いただきました。
実際に使用してみたところ、新たな疑問が生じたため投稿いたしました。
改めて助言をいただければと思いますので、よろしくお願いいたします。

【使用OS】Mac OS 10.9.5
【Excelのバージョン】Excel for mac 2011

【内容】
・即売会の売買明細として使用。販売分を入力→マクロで購入先に転記
・一社1シートとして、毎回20シート前後作成
・シートの内容
 →販売分(列12〜36)/セルA:価格/セルB:品名/セルC:数/セルD:売り先
 →購入分(列12〜36)/セルF:価格/セルG:品名/セルH:数/セルI:購入先
 →計上/B38:販売分合計額/G38:購入分合計額

【使用マクロ】
販売会社のセルA12〜D36に入力された売り内容を、
各購入先のシートのセルF12〜I36に転記するマクロです。

Sub 転記()

    Dim ws As Worksheet
    Dim i As Long
    Dim dstRng As Range     '転記先セル

    For Each ws In Worksheets
        ws.Range("F12").CurrentRegion.ClearContents
        ws.Range("F11:I11").Value = Array("価格", "品名", "数", "主")
    Next

    For Each ws In Worksheets
        For i = 12 To ws.Range("D" & Rows.Count).End(xlUp).Row
            With ws.Range("D" & i)
                Set dstRng = Worksheets(.Value).Range("F36").End(xlUp).Offset(1)
                .Offset(, -3).Resize(, 3).Copy dstRng
                dstRng.Offset(, 3).Value = ws.Name
            End With
        Next
    Next
 End Sub

【疑問点】
(1)
販売数が24点以上になった場合は、同じ会社の二枚目のシートを手動で作成して
以降のデータを入力しているのですが、一枚目に記載された販売分は「a社」と
転記されるのですが、二枚目の販売分は「a社(2)」と、シート名を反映した社名が
セルIに転記されてしまいます。シート名は「a社(2)」でも問題ないのですが、
転記される社名を一枚目と同様「a社」とするにはどうすればいいでしょうか。

(2)
販売分を転記して行く中で購入分が24点以上になった場合、
25点目以降は無視されてしまいます。
マクロで自動的に二枚目のシートを生成し、一枚目のシートの
購入合計額をG38に反映することは可能でしょうか。

< 使用 アプリ:excel for mac 2011、使用 OS:MacOSX >


 すべてのシートを対象に処理しているようですが、転記元は1シートで転記先とは
 別管理されていないのでしょうか?
 もしそうならば、 後半の For Each ws In Worksheets は不要な処理に思えるのですが。

 また、同じ社名のシートが複数で来た場合、最後以外のシートの G38 には何が入るの
 でしょうか。

 シートは最大2(データは必ず48以下)は将来も変わらない条件ですか?
(Mook) 2015/03/04(水) 23:52

(1)シート名が(2)でいいのか疑問ですが。1シートにしてしまえば不要な処理です。
    Dim iw As Long

    iw = InStrRev(ws.Name, " ")
    If 0 < iw Then
        dstRng.Offset(, 3).Value = Left(ws.Name, iw - 1)
    Else
        dstRng.Offset(, 3).Value = ws.Name
    End If

(2)シートを分けるより、24データに限定せず、1シートでエンドレスに使う方が自然かと。

> Set dstRng = Worksheets(.Value).Range("F36").End(xlUp).Offset(1)

この部分で、36行目より上で空欄でないセルを探しているので、F36セルよりもっと下から始めるだけです。
(???) 2015/03/05(木) 09:05


やっぱり、(1)は1行で済ませる、こっちの案の方をお薦め。
    dstRng.Offset(, 3).Value = Split(ws.Name, " ")(0)
(???) 2015/03/05(木) 09:15

Mook様、???様
レスありがとうございます。当方Excel初心者のため、とても助かります。

<転記元について>
即売会後、すぐにシートを印刷→各社に配布する必要があるので、
あらかじめ決められた順に沿って会社毎に販売した商品を記入→転記の流れが
一番即時性があるため、転記元は別管理していません。

<G38について>
また各社の販売分が多ければ主催から支払い、購入分が多ければ主催への支払いが
あるため、販売合計額と購入合計額、またその差額を同じシートの中に記載する必要があります。
そのため、最後以外のシートのG38はシート毎の合計額を記載するか、
もしくは空欄で処理してきました。

<シートに記入する最大数について>
過去、概ね一社24品程度で収まっていたため
そちらを最大数としておりましたが、???様にご指摘いただいたことで
1シートでエンドレスに使う方が良いように思いました。
その場合、どのような案が考えられるでしょうか。
(maki) 2015/03/05(木) 15:59


[[20140419215301]]

 データ48件(2シート分)までしか対応していません。
 サンプルデータ作るのが面倒なので、動作は未確認です。

 Sub 転記2()
    Dim ws As Worksheet
    Dim i As Long
    Dim dstRng As Range     '転記先セル
    Dim r As Long

    For Each ws In Worksheets
        With ws.Range("F12").CurrentRegion
            .Resize(.Rows.Count + 2).ClearContents
        End With
        ws.Range("F11:I11").Value = Array("価格", "品名", "数", "主")
    Next

    For Each ws In Worksheets
        For i = 12 To ws.Range("D" & Rows.Count).End(xlUp).Row
            With ws.Range("D" & i)
                Set dstRng = Worksheets(.Value).Range("F100").End(xlUp).Offset(1)
                .Offset(, -3).Resize(, 3).Copy dstRng
                dstRng.Offset(, 3).Value = ws.Name
            End With
        Next
    Next

    For Each ws In Worksheets
        r = ws.Range("G" & Rows.Count).End(xlUp).Row
        With ws.Range("G" & r + 2)
            .Value = WorksheetFunction.Sum(Range("G12:G" & r))
            .Offset(, -1).Value = "購入分合計額"
        End With

        '2シートに分けるならば以下を実行

        If r > 36 Then
            ws.Copy after:=ws
            ActiveSheet.Range("F12:I:36").Delete Shift:=xlShiftUp
            ws.Range("F37:I:" & r + 2).Delete Shift:=xlShiftUp
        End If
    Next

 End Sub

(マナ) 2015/03/05(木) 21:47


↑動作確認してないけど、だめそうです。

 >For Each ws In Worksheets
 ループ中に
 > ws.Copy after:=ws
 こんなことしたら、だめですよね。きっと。Beforeならいいのかな?

(マナ) 2015/03/05(木) 23:32


コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.