[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『転記用マクロの改変について』(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
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
dstRng.Offset(, 3).Value = Split(ws.Name, " ")(0) (???) 2015/03/05(木) 09:15
<転記元について>
即売会後、すぐにシートを印刷→各社に配布する必要があるので、
あらかじめ決められた順に沿って会社毎に販売した商品を記入→転記の流れが
一番即時性があるため、転記元は別管理していません。
<G38について>
また各社の販売分が多ければ主催から支払い、購入分が多ければ主催への支払いが
あるため、販売合計額と購入合計額、またその差額を同じシートの中に記載する必要があります。
そのため、最後以外のシートのG38はシート毎の合計額を記載するか、
もしくは空欄で処理してきました。
<シートに記入する最大数について>
過去、概ね一社24品程度で収まっていたため
そちらを最大数としておりましたが、???様にご指摘いただいたことで
1シートでエンドレスに使う方が良いように思いました。
その場合、どのような案が考えられるでしょうか。
(maki) 2015/03/05(木) 15:59
データ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.