ここから本文です

Microsoft Excelの質問です。 以下のようなVBAを使っています。 元ファイル1...

xzi********さん

2019/9/209:01:11

Microsoft Excelの質問です。

以下のようなVBAを使っています。

元ファイル1つに対し、転記先シート1行でループするようになっています。

今回、元ファイルのa1からd1を転記先シートの1行、転記先シートの次の行に同じ元ファイルのa4からd4を転記し、従来と同様にループさせたいと考えています。

どのように書き換えれば良いのか教えて頂けますでしょうか。

宜しくお願い致します。


Sub tenki()
'高速化 関数を後で計算
Application.Calculation = xlCalculationManual

'高速化 関数の操作を表示させない
Application.ScreenUpdating = False

'開始
Dim folder As String
Dim file As String
Dim book As Workbook
Dim i As Integer
'5行目から
i = 5

With Application.FileDialog(msoFileDialogFolderPicker)
If .Show = True Then
folder = .SelectedItems(1)
End If
End With

'ファイル選択
file = Dir(folder & "\*.xlsx")

Do While file <> ""

Set book = Workbooks.Open(folder & "\" & file)

'情報
ThisWorkbook.Worksheets("集計").Range("A" & CStr(i)).Value = book.Worksheets("報告台帳").Range("d5").Value
ThisWorkbook.Worksheets("集計").Range("b" & CStr(i)).Value = book.Worksheets("報告台帳").Range("d8").Value
ThisWorkbook.Worksheets("集計").Range("c" & CStr(i)).Value = book.Worksheets("報告台帳").Range("f5").Value
ThisWorkbook.Worksheets("集計").Range("d" & CStr(i)).Value = book.Worksheets("報告台帳").Range("d14").Value
ThisWorkbook.Worksheets("集計").Range("e" & CStr(i)).Value = book.Worksheets("報告台帳").Range("s14").Value
ThisWorkbook.Worksheets("集計").Range("f" & CStr(i)).Value = book.Worksheets("工事報告台帳").Range("t14").Value

file = Dir()
i = i + 1

book.Close

Loop

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

End Sub

閲覧数:
38
回答数:
1
お礼:
50枚

違反報告

ベストアンサーに選ばれた回答

プロフィール画像

カテゴリマスター

tra********さん

2019/9/209:48:32

もっと整理しないと無駄が多いです。無駄が多いということは、実行速度が落ちるということになりかねないです。


Sub tenkiⅡ()
Dim folder As String, file As String, i As Long
Dim sh As Worksheet
'高速化 関数を後で計算
Application.Calculation = xlCalculationManual
'高速化 関数の操作を表示させない
Application.ScreenUpdating = False
'開始
With Application.FileDialog(msoFileDialogFolderPicker)
If .Show = True Then
folder = .SelectedItems(1) & "\"
End If
End With

'5行目から
i = 5
Set sh = ThisWorkbook.Worksheets("集計")
'ファイル選択
file = Dir(folder & "*.xlsx")
Do While file <> ""
With Workbooks.Open(folder & file)
'情報
.Worksheets("報告台帳").Range("A1:D1,A4:D4").Copy
sh.Cells(i, 1).PasteSpecial xlPasteValues
.Close
End With
i = i + 2
file = Dir()
Loop
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub

返信を取り消しますが
よろしいですか?

  • 取り消す
  • キャンセル

みんなで作る知恵袋 悩みや疑問、なんでも気軽にきいちゃおう!

Q&Aをキーワードで検索:

Yahoo! JAPANは、回答に記載された内容の信ぴょう性、正確性を保証しておりません。
お客様自身の責任と判断で、ご利用ください。
本文はここまでです このページの先頭へ

「追加する」ボタンを押してください。

閉じる

※知恵コレクションに追加された質問は選択されたID/ニックネームのMy知恵袋で確認できます。

不適切な投稿でないことを報告しました。

閉じる