質問をすることでしか得られない、回答やアドバイスがある。

15分調べてもわからないことは、質問しよう!

新規登録して質問してみよう
ただいま回答率
85.50%
VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

コピー

元のオブジェクトを破壊することなく、オブジェクトの複製を生成することをコピーと呼びます。

マクロ

定義された処理手続きに応じて、どのような一連の処理を行うのかを特定させるルールをマクロと呼びます。

Q&A

解決済

1回答

810閲覧

VBA マクロでexcelのブックからブックに転記する際のソースの作成方法

icecleam

総合スコア46

VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

コピー

元のオブジェクトを破壊することなく、オブジェクトの複製を生成することをコピーと呼びます。

マクロ

定義された処理手続きに応じて、どのような一連の処理を行うのかを特定させるルールをマクロと呼びます。

0グッド

0クリップ

投稿2020/09/19 08:33

編集2020/09/19 13:00

以下の「現状のソース」を実行すると「現状の実行結果」のように転記が実行されてしまいます
最下部の「転記先」のように開発AがABC・・・と担当者が担当者数分だけ記載され、それが終わると開発Bというふうに転記されるようにしたいのですが、その処理がどうしても不正になってしまうので教えていただきたいです。

「現状のソース」の
'----- 「更新」シートの内容を現在のシートにコピー(自由に変更して下さい)
以降のコードで転記を実行しています。

宜しくお願いします。

現状の実行結果
イメージ説明

現状のソース

Macro

1Sub sample1() 2 3 Dim lngRowsNo As Long ' 書きこむ位置 4 Dim lngSheetIndex As Long ' シートの番号 5 Dim strFile As String ' Excelファイルの場所 6 Dim xlsAcq As New Excel.Application ' 取得側Excel 7 Dim wbAcq As Workbook ' 取得側Excelブック 8 Dim wsAcq As Worksheet ' 取得側Excelシート 9 Dim wsSet As Worksheet ' 設定側Excelシート 10 Const strPath As String = "フォルダパスを指定" 11 Set wsSet = ActiveSheet 12 Dim i As Long 13 14 15 strFile = Dir(strPath & "*.xls") 16 lngRowsNo = 2 17 Do Until strFile = "" 18 '----- Excelブックを開く 19 Set wbAcq = Workbooks.Open(strPath & strFile) 20 21 '----- シートを検索 22 For lngSheetIndex = 1 To wbAcq.Worksheets.Count 23 '----- 「更新」シートを検索 24 If wbAcq.Worksheets(lngSheetIndex).Name = "更新" Then 25 '----- 「更新」シートを変数へ登録 26 Set wsAcq = wbAcq.Worksheets(lngSheetIndex) 27 '----- 「更新」シートの内容を現在のシートにコピー(自由に変更して下さい) 28 With wsAcq 29 Dim n As Long 'ループで使用します。 30 Dim m As Long 'ループで使用します。 31 Dim ec1 As Long '各開発の一番下の担当者のセルを取得 32 33 For i = 1 To .UsedRange.Rows.Count 34 35 If Left(.Cells(i, 2).Value, 2) = "開発" Then 36 37 ' ------ 開発〇から一番上の担当者のセル位置を相対的にCells(i + 3, 3)として取得し 38 'データの入っているところまでループさせる (その時、開発名を転記) 39 40 ec1 = .Cells(i + 3, 3).End(xlDown).Row 41 For n = i + 3 To ec1 42 43 wsSet.Cells(lngRowsNo, 2).Value = .Cells(i, 2).Value 44 45 For m = i + 3 To ec1 46 47 wsSet.Cells(lngRowsNo, 3).Value = .Cells(i + 3, 3).Value 48 49 Next m 50 51 lngRowsNo = lngRowsNo + 1 52 53 Next n 54 End If 55 Next i 56 End With 57 58 '----- 検索の終了 59 Exit For 60 End If 61 Next lngSheetIndex 62 63 '----- シート参照の解放 64 Set wsAcq = Nothing 65 '----- ブックを閉じる 66 wbAcq.Close Savechanges:=False 67 '----- 次のファイルへ 68 strFile = Dir() 69 Loop 70 71 '----- Excelへの参照の解放 72 Set xlsAcq = Nothing 73 74End Sub

■マクロの概要
以下の画像のようにブックからブックへ転記をしたいです。
その時、転記元のエクセルファイル(拡張子はxls)が格納されているフォルダを指定してそのフォルダ内のエクセルファイルすべてに対してに「更新」というシートがあるときだけ以下の画像のように転記を実行したいです。(現在は作成途中で担当者を転記先のように転記したいです。)

転記元
転記元

転記先
転記先

気になる質問をクリップする

クリップした質問は、後からいつでもMYページで確認できます。

またクリップした質問に回答があった際、通知やメールを受け取ることができます。

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

coco_bauer

2020/09/19 08:59

転記元のシートの構造が良くないです。開発Aとか開発Bが、各表の左上というアクセスしにくところに在るのが問題です。 先に、転記元のシートに"開発"の列を加えて、そこに開発Aとかを埋めておけば、転記先と同じ構造になるので処理の見通しが良くなると思いますよ。更に、転記に関係しない転記元シートのF:G列(0がならんている列)等も削ると更に良いと思います。 出来の悪い転記元を、そのまま使おうとするからプログラムが複雑になっているのではないでしょうか?
icecleam

2020/09/19 09:03

すみません、転記元はこのファイル固定でという課題ですので、変更することはできないです。。 せっかくご助言をいただけたのに対応できず申し訳ないです。
guest

回答1

0

ベストアンサー

転記元の行指定を i で行っていますよね?
しかしnループ内でiの値は変わらないので、結局転記先のIngRowsNoのみが移動して、転記元は毎回 同じセルを読んでいます。
読む限り原因はここのように見えます。

そもそも2重ループする必要がないように思います。
結局nでec1まで回しているので、以下のようにループ1回で書けます。

VBA

1 For n = i + 3 To ec1 2 3 wsSet.Cells(lngRowsNo, 2).Value = .Cells(i, 2).Value 4 wsSet.Cells(lngRowsNo, 3).Value = .Cells(n, 3).Value 5 6 lngRowsNo = lngRowsNo + 1 7 8Next n

投稿2020/09/19 16:36

Usirow

総合スコア364

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

icecleam

2020/09/19 17:10

ありがとうございます。 上記のソースで、無事実行できました。
guest

あなたの回答

tips

太字

斜体

打ち消し線

見出し

引用テキストの挿入

コードの挿入

リンクの挿入

リストの挿入

番号リストの挿入

表の挿入

水平線の挿入

プレビュー

15分調べてもわからないことは
teratailで質問しよう!

ただいまの回答率
85.50%

質問をまとめることで
思考を整理して素早く解決

テンプレート機能で
簡単に質問をまとめる

質問する

関連した質問