Question

我正在尝试构建一个宏来整理特定文件夹中存在的信息，但我只需要选择我在特定行中突出显示的文件并整理相邻列中的数据。请帮助我如何执行任务。我已经编写了打开文件和文件夹的基本语法。

Private Sub CommandButton2_Click()
  Const FOLDER As String = "C:\SBI_FILES_1\"
  Const cStrWSName As String = "addl disclosures"
  Const cStrRangeAddress As String = "F30:F33"

Dim rngTarget As Range
Dim wbSource As Workbook

Dim fileName As String

On Error GoTo ErrorHandler

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Set rngTarget = ThisWorkbook.Worksheets(cStrWSName).Range(cStrRangeAddress)

fileName = Dir(FOLDER, vbDirectory)
Do While Len(fileName) > 0

    If Right$(fileName, 4) = "xlsx" Or Right$(fileName, 3) = "xls" Then
     "I need to modify code here"
        Set wbSource = Workbooks.Open(FOLDER & fileName)

        wbSource.Worksheets(cStrWSName).Range(cStrRangeAddress).Copy
        rngTarget.PasteSpecial xlPasteValues, xlPasteSpecialOperationAdd

        wbSource.Close
    End If
    fileName = Dir
Loop

ProgramExit:
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
Exit Sub

ErrorHandler:
    MsgBox Err.Number & " - " & Err.Description

    Resume ProgramExit
End Sub

Answer 1

假设您在某个范围内的活动表格中有文件名 * A2到A10 *

Private Sub CommandButton2_Click()
  Const FOLDER As String = "C:\SBI_FILES_1\"
  Const cStrWSName As String = "addl disclosures"
  Const cStrRangeAddress As String = "F30:F33"

Dim erange as range
Dim rng as range

Dim rngTarget As Range
Dim wbSource As Workbook

Dim fileName As String

On Error GoTo ErrorHandler

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

set rng = activesheet.range("A2:A10") ' filenames

Set rngTarget = ThisWorkbook.Worksheets(cStrWSName).Range(cStrRangeAddress)

fileName = Dir(FOLDER, vbDirectory)
Do While Len(fileName) > 0

    If Right$(fileName, 4) = "xlsx" Or Right$(fileName, 3) = "xls" Then


for each erange in rng


if instr(filename,erange.value) > 0 then ' checking file name whether its matches or not 

        Set wbSource = Workbooks.Open(FOLDER & fileName)

        wbSource.Worksheets(cStrWSName).Range(cStrRangeAddress).Copy
        rngTarget.PasteSpecial xlPasteValues, xlPasteSpecialOperationAdd

        wbSource.Close

end if 

next erange




    End If
    fileName = Dir
Loop

ProgramExit:
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
Exit Sub

ErrorHandler:
    MsgBox Err.Number & " - " & Err.Description

    Resume ProgramExit
End Sub

使用循环仅从文件夹中选择特定文件

1 个答案: