[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『マクロを使用した別シートへの転記について』（maki）
以前こちらでマクロを教えていただいて、初心者なりに
伝票を作成してみたのですが、またトラブルになってしまったので
助けていただければと思い、書き込みさせていただきました。
下記のような伝票を、会社毎にシートに分けています。
セルA〜Dが販売分、セルF〜Iが購入分です。
＜A社＞
A B C D
11 単価 商品 個数 社名
12 \20000 商品あ 1 B社
13 \50000 商品い 1 C社
14 \2000 商品う 5 B社
15 \30000 商品え 1 D社
＜B社＞
F G H I
11 単価 商品 個数 社名
12 \20000 商品あ 1 A社
13 \2000 商品う 5 A社
セルA〜Dに記入したものを、販売先の会社のシートのF〜Iに転記できるよう、
行ごとにボタンを設置して下記のマクロを登録しています。
Sub 伝票シート1() Dim v v = Sheets(“A社”).Cells(12, 4)
Sheets(v).Range("F12").CurrentRegion = Empty
Sheets(v).Range("F12:I12") = Array(“単価”, “商品”, “個数”, “社名”)
Dim i As Long, n As Long
n = 11
For i = 10 To Cells(Rows.Count, "D").End(xlUp).Row
If Cells(i, "D").Value = v Then
n = n + 1
With Sheets(v)
.Cells(n, 6).Value = Cells(i, 1).Value
.Cells(n, 7).Value = Cells(i, 2).Value
.Cells(n, 8).Value = Cells(i, 3).Value
.Cells(n, 9).Value = “A社”
End With
End If
Next
End Sub
※3行目のセルの位置は、マクロを実行する行が変わるたびに変更しています。
A社販売分を入力→他社シートに転記し終え、
上記マクロの社名をB社に置き換えてB社販売分を入力して
他社シートに転記しようとしたところ、
A社の販売分にB社の販売分が上書きされた上、
転記した内容が社名以外消えてしまいます。
＜C社＞
F G H I
11 単価 商品 個数 社名
12 \50000 商品い 1 A社
13 \60000 商品う 1 A社
↓ B社販売分を転記
＜C社＞
F G H I
11 単価 商品 個数 社名
12 \80000 商品え 1 B社
13 A社
超初心者のため、どこがどうしてこうなってしまうのか
全くわからない状態です…。
大変恐縮ですが、何卒お力添えください。
よろしくお願いいたします。
＜ 使用 アプリ：excel for mac 2011、使用 OS：MacOSX ＞
Sub test()
Dim ws As Worksheet
Dim i As Long
For Each ws In Worksheets
ws.Columns("F:I").ClearContents
ws.Range("F11:I11") = Array("単価", "商品", "個数", "社名")
Next
For Each ws In Worksheets
For i = 12 To ws.Range("D" & Rows.Count).End(xlUp).Row
With ws.Range("D" & i)
.Offset(, -3).Resize(, 4).Copy _
Worksheets(.Value).Range("F" & Rows.Count).End(xlUp).Offset(1)
End With
Next
Next
End Sub
（マナ） 2014/04/20(日) 08:04
ご教示いただきありがとうございます。
さっそくテストしてみたところ、
「実行時エラー 1004
結合されたセルの一部を変更することはできません」
というエラーメッセージが出てきてしまい、
デバッグをすると
ws.Columns("F:I").ClearContents
の行にチェックが入ります。
セルF、Iの列は伝票の構成上、行3〜7部分を結合しているのが
原因かと思い、分割して再度マクロを実行してみたのですが
同じエラーが出てきてしまいました。
度々で恐縮ですが、原因をご教示いただけますと幸いです。
よろしくお願いいたします。
（maki） 2014/04/20(日) 08:50
ws.Columns("F:I").ClearContents
↓
ws.Range("F12").CurrentRegion.ClearContents
（マナ） 2014/04/20(日) 08:58
早速のご返信、ありがとうございます。
変更してみたところ、今度は
「実行時エラー 1004
RangeクラスのCopyメソッドが失敗しました」
というメッセージが出てきてしまいました。
再度デバッグをかけてみたところ、今度は
.Offset(, -3).Resize(, 4).Copy _
Worksheets(.Value).Range("F" & Rows.Count).End(xlUp).Offset(1)
の行にチェックが入ります。
お手数をおかけして本当に申し訳ありませんが、
原因をご教示ください。よろしくお願いいたします。
（maki） 2014/04/20(日) 09:04
エラーが出た段階で、F〜Iにデータは全く転記されていませんか？ それとも、何件かは転記されていますか。
（マナ） 2014/04/20(日) 09:35
ご返信ありがとうございます。
マクロを登録したボタンをクリックすると
エラーメッセージが出てしまいます。
転記先を確認すると、セルは空白のまま
という状態です。
（maki） 2014/04/20(日) 09:51
今、新規ブックで試してみたら出来ました！
もう少しテストを重ねてみたいので、
結果が出次第またご報告させていただきます。
ありがとうございました！
（maki） 2014/04/20(日) 09:58
すると、内容は目的のシートに転記はされるのですが、
なぜか転記先がF37〜I37以下に蓄積される形に
なってしまいます。
F12〜I12→F34〜I34の間に蓄積される形で転記したいのですが、
これはどう修正すればよいのでしょうか…。
ちなみに行35は都合により空欄、
行36は各単価の合計欄になっています。
（maki） 2014/04/20(日) 11:08
.Offset(, -3).Resize(, 4).Copy _
Worksheets(.Value).Range("F" & Rows.Count).End(xlUp).Offset(1)
↓
.Offset(, -3).Resize(, 4).Copy _
Worksheets(.Value).Range("F36").End(xlUp).Offset(1)
F36セルから上方向にたどっていき、最初にデータがみつかったセルの１個下のセルにコピー
（マナ） 2014/04/20(日) 11:36
度々のご回答、ありがとうございます！
セルへの転記は無事解決したのですが、
また別の問題が生じてしまいました…。
A社販売分は問題なく転記できたのですが、
同じマクロを使用してB社販売分を転記したところ、
I列の社名が転記先の社名に変更されてしまうと同時に、
A社転記分まで社名が変更されてしまいました。
＜C社＞ F G H I 11 単価 商品 個数 社名 12 \50000 商品い 1 A社 13 \60000 商品う 1 A社
↓ B社販売分を転記
＜C社＞
F G H I
11 単価 商品 個数 社名
12 \50000 商品い 1 C社 ←A社販売分
13 \60000 商品う 1 C社 ←A社販売分
14 \60000 商品う 1 C社 ←B社販売分
大変恐縮なのですが後学のため、前返信のように
コードの意味を添えてご教示いただけますと幸いです。
（今回は諸事情で早急な解決が必要なのですが、
このままではいつまで経っても教えてちゃんのままなので…）
こちらの我儘でいろいろとお願いしてしまって申し訳ありませんが、
よろしくお願いいたします。
（maki） 2014/04/20(日) 12:08
１）マクロは１回の実行で、A社、B社、C社すべて転記されます。 For each ws in Worksheets〜Nextとすることで すべてのシートについて順番に処理しています。
２）１行が長くなるので、転記先セルには変数を使用しました。
Set dstRng = Worksheets(.Value).Range("F36").End(xlUp).Offset(1)
３）転記の構文は、「コピー元範囲.Copy 転記先セル」
ws.Range("D" & i).Offset(, -3).Resize(, 3).Copy dstRng
この場合、コピー元範囲はA列からC列の３個 修正前は、Resize(, 4)としていたので、A列からD列までの４個のセルをコピー
４）転記先で表示する社名は、購入先（どのシートからコピーしたか） シートの名前は、ws.Nameで取得できる、それを転記先セルの３個右横のセルに表示 dstRng.Offset(, 3).Value = ws.Name
Sub test2()
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
（マナ） 2014/04/20(日) 13:10
重ね重ねありがとうございます！
テストシートで問題なく実行されました！
実際使用するファイルに当てはめてみて、
改めてテストしてみます。
またご報告いたしますので、
取り急ぎお礼まで。
（maki） 2014/04/20(日) 13:19
windowsマシンでテストしていたのですが、
macで実際に使用する仕様で試してみたところ、
無事実行することが出来ました！
短時間で、しかも最初よりずっと楽に解決する方法を
ご教示いただき、本当にありがとうございました。
これから改めてご教示いただいたマクロのコードの詳細を
拝見し、勉強したいと思います。
本当にありがとうございました！
（maki） 2014/04/20(日) 17:50
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.