将值从多个工作簿复制到主文件中的特定单元格

Posted 2023-03-27

【中文标题】将值从多个工作簿复制到主文件中的特定单元格

【英文标题】：Copying values from multiple workbooks to specific cells in a master

【发布时间】：2022-01-19 17:33:53

【问题描述】：

嗨嗨， 免责声明：我没有编码经验 我有一个代码，它从桌面文件夹中的多个工作表中的单元格（B2：C2）中获取值并将其粘贴到主工作簿中。这很好用，但是，我不希望将复制的单元格连续粘贴到单元格 (F3:G3) 中——它们需要粘贴到特定的单元格中。这听起来很复杂，我敢肯定。首先，这是我修改的基本代码 (from this code) 以满足我的需要：

Sub MergeAllWorkbooks()
Dim SummarySheet As Worksheet
Dim FolderPath As String
Dim FileName As String
Dim WorkBk As Workbook
Dim SourceRange As Range
Dim DestRange As Range

'Optimize Macro Speed
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual

' Set summarysheet to activeworkbook/activesheet where the macro runs
Set SummarySheet = ActiveWorkbook.ActiveSheet

' Modify this folder path to point to the files you want to use.
FolderPath = "C:\Users\Me\Desktop\Extracted Data\16.12.2021\"

' Call Dir the first time, pointing it to all Excel files in the folder path.
FileName = Dir(FolderPath & "*.csv*")

' Loop until Dir returns an empty string.
Do While FileName <> ""
    ' Open a workbook in the folder
    Set WorkBk = Workbooks.Open(FolderPath & FileName)

    'loop through all Sheets in WorkBk
    For Each sh In WorkBk.Worksheets
      
    ' Set the source range to be A9 through C9.
      Set SourceRange = Sheets(sh.Name).Range("B2:C2")
    
    ' Set the destination range to start at column B and
    ' be the same size as the source range.
    Set DestRange = SummarySheet.Range("F" & SummarySheet.Range("F" & Rows.Count).End(xlUp).Row + 1)
    Set DestRange = DestRange.Resize(SourceRange.Rows.Count, _
       SourceRange.Columns.Count)
    
    ' Copy over the values from the source to the destination.
    DestRange.Value = SourceRange.Value
    
    Next sh
    
    ' Close the source workbook without saving changes.
    WorkBk.Close savechanges:=False
    
    ' Use Dir to get the next file name.
    FileName = Dir()
Loop
    
' Call AutoFit on the destination sheet so that all
' data is readable.
ActiveSheet.Columns.AutoFit

'Message Box when tasks are completed
MsgBox "Task Complete!"

End Sub

因此，这会运行并将源文件夹中每个工作簿中的值复制到主文件夹。我想这样做： 如果它从包含即“282579”和“Ch.4”的工作簿复制到与这些值对应的单元格。为了澄清，我在我的主工作簿中添加了一个Screenshot。 如果它从标题包含 282579 和 Ch.4 的源工作簿中复制一个值，它会将这两个值粘贴到位于 (F10:G10) 的 282579 的 Ch.4 单元格中，依此类推。 尝试使用 If 函数（例如，如果（工作簿的名称中有 this），但我不知道如何指定需要粘贴的单元格）

我希望我说得有道理并且这是可以理解的。

编辑：如果需要我使用的数据的副本，我可以提供它

【问题讨论】：

工作簿是否有多个工作表？

不，每个工作簿（包括母版和源版）只有一张。

好的，你在代码中'循环遍历 WorkBk For Each sh In WorkBk.Worksheets 中的所有工作表，这让我感到困惑。对于工作簿 282579 和 Ch.4，文件名是什么，它是 282579Ch.4.xlsx，文件名中带有点？

我刚刚从其他人那里复制了这个 here 我想我不需要它，但这不是我遇到的问题，因为它确实复制/粘贴到我的掌握。源文件名类似于：“VS SAAV_282579 ch 4 Data”（282579 和 ch 4 更改值）。这是一个 .csv 工作簿

【参考方案1】：

使用正则表达式提取 SN 和 Ch。文件名中的数字。使用 Find 在摘要表上找到 SN，然后扫描合并的行以查找 Ch 编号。

Sub MergeAllWorkbooks()

    ' Modify this folder path to point to the files you want to use.
    Const FolderPath = "C:\Users\Me\Desktop\Extracted Data\16.12.2021\"
    
    Dim wb As Workbook, wbCSV As Workbook
    Dim ws As Worksheet, wsCSV As Worksheet
    Dim rngCSV As Range, fnd As Range, bFound As Boolean
    Dim Filename As String, n As Long, i As Long
       
    ' Set summarysheet to activeworkbook/activesheet where the macro runs
    Set wb = ActiveWorkbook
    Set ws = wb.ActiveSheet
    
    ' regular expression to extract numbers
    ' example VS SAAV_282579 ch 4 Data.csv
    Dim Regex As Object, m As Object, SN As Long, CH As Long
    Set Regex = CreateObject("vbscript.regexp")
    With Regex
       .IgnoreCase = True
       .Pattern = "(_(\d+) +ch +(\d+) +Data)"
    End With
    
    ' Call Dir the first time, pointing it to all Excel files in the folder path.
    Filename = Dir(FolderPath & "*Data.csv*")
    
    ' Loop until Dir returns an empty string.
    Application.ScreenUpdating = False
    Do While Filename <> ""
        
        ' extract SN and Ch from filename
        If Regex.test(Filename) Then
            Set m = Regex.Execute(Filename)(0).submatches
            SN = m(1)
            CH = m(2)
            Debug.Print Filename, SN, CH
            
            ' Find SN
            Set fnd = ws.Range("B:B").Find(SN, LookIn:=xlValues, lookat:=xlWhole)
            If fnd Is Nothing Then
                 MsgBox SN & " not found !", vbCritical, Filename
            Else
               ' find ch.
               bFound = False
               For i = 0 To fnd.MergeArea.Count - 1
                    If ws.Cells(fnd.Row + i, "D") = CH Then ' Col D
                        bFound = True
                        ' Open a workbook in the folder
                        Set wbCSV = Workbooks.Open(FolderPath & Filename, ReadOnly:=True)
                        ws.Cells(fnd.Row + i, "F").Resize(, 2).Value2 = wbCSV.Sheets(1).Range("B2:C2").Value2
                         ' Close the source workbook without saving changes.
                        wbCSV.Close savechanges:=False
                        Exit For
                    End If
                Next
                If bFound = False Then
                    MsgBox "Ch." & CH & " not found for " & SN, vbExclamation, Filename
                End If
            End If
            n = n + 1
        Else
            Debug.Print Filename & " skipped"
        End If
        ' Use Dir to get the next file name.
        Filename = Dir()
    Loop
        
    ' Call AutoFit on the destination sheet so that all
    ' data is readable.
    ws.Columns.AutoFit
    Application.ScreenUpdating = True
    
    'Message Box when tasks are completed
    MsgBox n & " csv files found.", vbInformation, "Task Complete!"

End Sub

【讨论】：

到目前为止，这非常有效，非常感谢！最后，我将如何编辑代码以包含具有“v2”的文件名，例如 VS SAAV_282579v2 ch 4 Data.csv？

@inuity_ 将正则表达式中的模式更改为.Pattern = "(_(\d+).*ch +(\d+) +Data)"

您好，又是一个小问题：通常文件在 ch 之后有一个空格，如 'ch 4'，我怎样才能让它仍然读取文件，即使它之后没有空格，因为它错过了这些？除了“ch 4”，还有“ch4”。

@inuity ch + 匹配 1 个或多个空格，ch * 匹配 0 个或多个空格，ch ? 匹配 0 个或 1 个空格。

【参考方案2】：

根据您的解释，不清楚您是否能够将源工作表与特定的 Ch.如果可以的话，我建议在 For each sh 循环之后立即定义一个 Ch 变量，然后您需要在主工作簿中为每一行的 D 列启动另一个循环，直到您获得 Ch 变量的行号。您使用行号来定义目标范围

Dim SummarySheet As Worksheet
Dim FolderPath As String
Dim FileName As String
Dim WorkBk As Workbook
Dim SourceRange As Range
Dim DestRange As Range
Dim n As Long 'Ch substring position
Dim Ch As String 'Ch variable for source file
Dim LastChRow As Long 'lastrow of Ch in summary sheet
Dim ChSummary As String 'Define the Ch string in summary sheet


'Optimize Macro Speed
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual

' Set summarysheet to activeworkbook/activesheet where the macro runs
Set SummarySheet = ActiveWorkbook.ActiveSheet
' Define LastChRow
LastChRow = SummarySheet.Cells(Rows.Count, "D").End(xlUp).Row

' Modify this folder path to point to the files you want to use.
FolderPath = "C:\Users\Me\Desktop\Extracted 
Data\16.12.2021\"

' Call Dir the first time, pointing it to all Excel files in the 
folder path.
FileName = Dir(FolderPath & "*.csv*")

' Loop until Dir returns an empty string.
Do While FileName <> ""



'define starting charachter of Ch source file for string manipulation
n = InStr(FileName, "Ch")

'define Ch variable
Ch = Trim(Mid(FileName, n, 5))
 
' Open a workbook in the folder
Set WorkBk = Workbooks.Open(FolderPath & FileName)
 'loop through all Sheets in WorkBk
For Each sh In WorkBk.Worksheets
    For i = 3 To LastChRow
        'Define ChSummary variable in loop
        ChSummary = "Ch" & " " & SummarySheet.Range("D" & i)
        
        If ChSummary = Ch Then
    
        ' Set the source range to be A9 through C9.
        Set SourceRange = Sheets(sh.Name).Range("B2:C2")
        
        ' Set the destination range to start at column B and
        ' be the same size as the source range.
        Set DestRange = SummarySheet.Range("F" & i & ":G" & i)
        'Set DestRange = DestRange.Resize(SourceRange.Rows.Count, _
        '   SourceRange.Columns.Count)
        
        ' Copy over the values from the source to the destination.
        DestRange.Value = SourceRange.Value
        
        End If
        
    Next i
    
Next sh

' Close the source workbook without saving changes.
WorkBk.Close savechanges:=False

' Use Dir to get the next file name.
FileName = Dir()'

【讨论】：

确切地说，我可以让代码粘贴来自所有来源的值，但我无法做到，如果源工作簿的名称为 'xxxxxx' + 'ch.x' 它会传递到如截图所示，具有相应单元名称“xxxxxx”和“ch”的 master。

根据您的信息，我在之前的回答中添加了一个代码提案。如果所有 csv 的工作表名称一致，我认为您不需要通过 sh.Name 循环。无论如何我都把它放在那里