VBA：1セルからマスター

Question

単一のセル値に基づいてインデックス付けされた何千ものエクセル（2016）シートが必要です。ワークブックにはワークシートが1つしかなく、データは常にセルD2に存在します。

2番目の列のマスターファイルにD2をコピーし、最初に関連するファイルの名前を付けたいとします。 個々のExcelファイルは既にサブフォルダに分割されています。

私は一般的にコーディングには新しいので、物事を段階的に説明することができればボーナスポイントになります。私はフォローして学びたい。

先進的なサポートをいただきありがとうございます！

編集：私は前にシートを有効にしなかった

もの、他のブックを起動し、その後、ファイルを変更しました。私は他のワークシートを活性化していないので、私は次に何をするのかと迷っています。ただ彼らからデータを取り出すだけです。彼らは開かれる必要はありません。

ループはファイルを呼び出す必要があります。 次に、範囲を選択>コピー>呼び出しマスタファイル>有効化>貼り付け>行数を1に設定して、選択したセルをシフトダウンしてください>

ただし、名前がないので先行するセルの名前を、そのファイルのファイル名から取り出したいとします。これに関するヘルプを検索すると、ファイル名またはパスの後にワークシート内のセルに名前を付ける方法、それを逆にしたい場所、毎回変わる別のソースから名前を付ける方法しか得られません。ループへ

コード：

Option Explicit 

Sub deeploop() 
Dim objFSO As Object 
Dim objFolder As Object 
Dim objSubFolder As Object 
Dim objFile As Object 
Dim MyFolder As String 
Dim wkbOpen As Workbook 
Dim wkb As Workbook 
Dim wks As Worksheet 
Dim CalcMode As Long 

With Application 
    CalcMode = .Calculation 
    .Calculation = xlCalculationManual 
    .ScreenUpdating = False 
    .EnableEvents = False 
End With 

'Change path 
MyFolder = "C:\Path" 

Set objFSO = CreateObject("Scripting.FileSystemObject") 
Set objFolder = objFSO.GetFolder(MyFolder) 
Set wkb = ActiveWorkbook 
Set wks = ActiveSheet 

For Each objSubFolder In objFolder.SubFolders 
    For Each objFile In objSubFolder.Files 
     Set wkbOpen = Workbooks.Open(objFile.Path) 


'code 


     wkbOpen.Close savechanges:=True 
    Next objFile 
Next objSubFolder 

With Application 
    .Calculation = CalcMode 
    .ScreenUpdating = True 
    .EnableEvents = True 
End With 


End Sub 

Answer 1

彼らは、たとえそうであっても、それらを開いていない

をオープンする必要はありません！

そして、ちょうど適切なセルにシート1「にちなんで命名されたExcelブックのすべてのあなたの何千ものシートのみを想定し、ファイルパス、ファイル名とシート名

との完全修飾指し、あなたのアクティブなシートに数式を入れます」次のように、あなたが行動することができます：

Option Explicit 

Sub deeploop() 
    Dim objFSO As Object 
    Dim objFolder As Object 
    Dim objSubFolder As Object 
    Dim objFile As Object 
    Dim MyFolder As String 
    Dim CalcMode As Long 
    Dim ifile As Long 

    With Application 
     CalcMode = .Calculation 
     .Calculation = xlCalculationManual 
     .ScreenUpdating = False 
     .EnableEvents = False 
    End With 

    'Change path 
    MyFolder = "C:\Path" 

    Set objFSO = CreateObject("Scripting.FileSystemObject") 
    Set objFolder = objFSO.GetFolder(MyFolder) 

    With ActiveSheet.Range("A1:B1") '<--| it suffices to reference the 'ActiveSheet' object since it belongs to 'ActiveWorkbook' by default 
     For Each objSubFolder In objFolder.SubFolders 
      For Each objFile In objSubFolder.Files 

       .Offset(ifile).Value = Array(objFile.Name, "='" & objSubFolder.Path & "\[" & objFile.Name & "]Sheet1'!$D$2") 
       ifile = ifile + 1 

      Next objFile 
     Next objSubFolder 
    End With 

    With Application 
     .Calculation = CalcMode 
     .ScreenUpdating = True 
     .EnableEvents = True 
    End With 
End Sub