2016-11-07 6 views
1

インターネット上で見つかったコードを、フォルダ内のファイルからデータを取り出して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にはほとんど知識を持っていると私は実際には名前があるファイルをスキップ策定するか見当がつかないすでにマスターシートに入っています。

ありがとうございます!

答えて

0

Uのファイル名がファイル拡張子のあるパス全体であると仮定します。すなわちC:\Users\SL\Desktop\TestFile.xls

Findメソッドを使用すると、各ループの開始時にsFileに一致する列Uのエントリを検索できます。一致するものが見つかった場合は、そのファイルをスキップして移動し、そうでない場合は処理します。無限ループを回避するには、sFile = Dir()Ifステートメントの外側に配置してください。

Dim PathMatch As Range 

'loop through the Excel files in the folder 
sFile = Dir(FOLDER_PATH & "*.xls*") 

Do Until sFile = "" 
    With wsMaster.Range("U:U") 
     Set PathMatch = .Find(What:=sFile, _ 
            After:=.Cells(.Cells.Count), _ 
            LookIn:=xlValues, _ 
            LookAt:=xlWhole, _ 
            SearchOrder:=xlByRows, _ 
            SearchDirection:=xlNext, _ 
            MatchCase:=False) 
    End With 

    If Not PathMatch Is Nothing Then 
     Debug.Print "File already processed, skip to next file." 
    Else 
     Debug.Print "File not processed yet, do it now" 

     '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 
    End If 
    sFile = Dir() 
Loop 

ファイル名のみではなく、あなたがそれに応じsFileを解析する必要がありますパスを持っている場合。それを行うにはHere are a few ways

関連する問題