インターネット上で見つかったコードを、フォルダ内のファイルからデータを取り出して1つのマスターシートに配置するように調整しました。Excel VBA:既に処理済みのものをスキップしてフォルダ内のファイルからデータを取り出すマクロ
しかし、ファイルの数値は毎週非常に急速に増加するため、マクロで既に処理されたファイルをスキップするコードに実装したいと考えています。私はマスターシート(列U)のファイル名を調べることによってそれをしたいと思います。
以下のコードを見つけてください:
Option Explicit
Const FOLDER_PATH = "Z:\...\...\...\" 'REMEMBER END BACKSLASH
Sub ImportWorksheets()
'=============================================
'Process all Excel files in specified folder
'=============================================
Dim sFile As String 'file to process
Dim fName As String
Dim wsTarget As Worksheet
Dim wbSource As Workbook
Dim wsSource As Worksheet
Dim rowTarget As Long 'output row
Dim wsMaster As Worksheet
Dim NR As Long
rowTarget = 3
'Setup
Application.ScreenUpdating = False 'speed up macro execution
Application.EnableEvents = False 'turn off other macros for now
Application.DisplayAlerts = False 'turn off system messages for now
Set wsMaster = ThisWorkbook.Sheets("Arkusz1") 'sheet report is built into
With wsMaster
If MsgBox("Clear the old data first?", vbYesNo) = vbYes Then
.UsedRange.Offset(2).Columns(3).Clear
.UsedRange.Offset(2).Columns(4).Clear
.UsedRange.Offset(2).Columns(5).Clear
.UsedRange.Offset(2).Columns(6).Clear
.UsedRange.Offset(2).Columns(7).Clear
.UsedRange.Offset(2).Columns(8).Clear
.UsedRange.Offset(2).Columns(9).Clear
.UsedRange.Offset(2).Columns(10).Clear
.UsedRange.Offset(2).Columns(11).Clear
.UsedRange.Offset(2).Columns(12).Clear
.UsedRange.Offset(2).Columns(13).Clear
.UsedRange.Offset(2).Columns(14).Clear
.UsedRange.Offset(2).Columns(15).Clear
.UsedRange.Offset(2).Columns(17).Clear
.UsedRange.Offset(2).Columns(18).Clear
.UsedRange.Offset(2).Columns(20).Clear
NR = 3
Else
NR = .Range("A" & .Rows.Count).End(xlUp).Row + 1 'appends data to existing data
End If
'check the folder exists
If Not FileFolderExists(FOLDER_PATH) Then
MsgBox "Specified folder does not exist, exiting!"
Exit Sub
End If
'reset application settings in event of error
On Error GoTo errHandler
Application.ScreenUpdating = False
'set up the target worksheet
Set wsTarget = Sheets("Arkusz1")
'loop through the Excel files in the folder
sFile = Dir(FOLDER_PATH & "*.xls*")
Do Until sFile = ""
'open the source file and set the source worksheet - ASSUMED WORKSHEET(1)
Set wbSource = Workbooks.Open(FOLDER_PATH & sFile)
Set wsSource = wbSource.Worksheets(3) 'EDIT IF NECESSARY
'import the data
With wsTarget
.Range("C" & rowTarget).Value = wsSource.Range("F4").Value
.Range("D" & rowTarget).Value = wsSource.Range("J4").Value
.Range("E" & rowTarget).Value = wsSource.Range("J7").Value
.Range("F" & rowTarget).Value = wsSource.Range("J10").Value
.Range("G" & rowTarget).Value = wsSource.Range("J19").Value
.Range("H" & rowTarget).Value = wsSource.Range("L19").Value
.Range("I" & rowTarget).Value = wsSource.Range("H17").Value
.Range("J" & rowTarget).Value = wsSource.Range("N27").Value
.Range("K" & rowTarget).Value = wsSource.Range("N29").Value
.Range("L" & rowTarget).Value = wsSource.Range("N36").Value
.Range("M" & rowTarget).Value = wsSource.Range("N38").Value
.Range("N" & rowTarget).Value = wsSource.Range("J50").Value
.Range("O" & rowTarget).Value = wsSource.Range("L50").Value
.Range("Q" & rowTarget).Value = wsSource.Range("J52").Value
.Range("R" & rowTarget).Value = wsSource.Range("L52").Value
.Range("T" & rowTarget).Value = wsSource.Range("N57").Value
'optional source filename in the last column
.Range("U" & rowTarget).Value = sFile
End With
'close the source workbook, increment the output row and get the next file
wbSource.Close SaveChanges:=False
rowTarget = rowTarget + 1
sFile = Dir()
Loop
End If
'Format columns to the desired format
.UsedRange.Offset(2).Columns(7).NumberFormat = "### ### ##0"
.UsedRange.Offset(2).Columns(8).NumberFormat = "### ### ##0"
.UsedRange.Offset(2).Columns(9).NumberFormat = "#,##0.00 $"
.UsedRange.Offset(2).Columns(10).NumberFormat = "#,##0.00 $"
.UsedRange.Offset(2).Columns(11).NumberFormat = "#,##0.00 $"
.UsedRange.Offset(2).Columns(12).NumberFormat = "#,##0.00 $"
.UsedRange.Offset(2).Columns(13).NumberFormat = "#,##0.00 $"
.UsedRange.Offset(2).Columns(14).NumberFormat = "0.00%"
.UsedRange.Offset(2).Columns(15).NumberFormat = "0.00%"
.UsedRange.Offset(2).Columns(16).NumberFormat = "0.00%"
.UsedRange.Offset(2).Columns(17).NumberFormat = "0.00%"
.UsedRange.Offset(2).Columns(18).NumberFormat = "0.00%"
.UsedRange.Offset(2).Columns(19).NumberFormat = "0.00%"
.UsedRange.Offset(2).Columns(20).NumberFormat = "0.00%"
errHandler:
On Error Resume Next
Application.ScreenUpdating = True
'tidy up
Set wsSource = Nothing
Set wbSource = Nothing
Set wsTarget = Nothing
End With
End Sub
Private Function FileFolderExists(strPath As String) As Boolean
If Not Dir(strPath, vbDirectory) = vbNullString Then FileFolderExists = True
End Function
私がもし後藤文で、それを作ってみましたが、私はVBAにはほとんど知識を持っていると私は実際には名前があるファイルをスキップ策定するか見当がつかないすでにマスターシートに入っています。
ありがとうございます!