如何使用VBA递归运行文件夹中所有文件的宏

时间:2019-07-24 12:38:15

标签: excel vba

我创建了一个VBA宏,该宏使用户可以打开HTML文件,将其复制到活动工作簿的工作表中,进行一些替换和垂直查找,最后保存它。

如果我想让用户选择不仅对单个HTML文件而且对文件夹中的所有文件执行相同的操作怎么办?我怎样才能让他只输入文件夹的路径,并让宏对所有文件进行处理?

这是我的代码:

Sub CopyOutput()
    Dim wb1 As Workbook, wb2 As Workbook
    Dim Ret1, Ret2

    Set wb1 = ActiveWorkbook

    '~~> Get the File
    Ret1 = Application.GetOpenFilename("Across Report (*.htm*), *.htm*", _
    , "Please select file")
    If Ret1 = False Then Exit Sub

    Set wb2 = Workbooks.Open(Ret1)
    wb2.Sheets(1).Cells.Copy wb1.Sheets(2).Cells
    wb2.Close SaveChanges:=False

    Set wb2 = Nothing
    Set wb1 = Nothing

    Sheets("Tabelle2").Select
    Cells.Select
    Selection.Copy
    Sheets("Tabelle3").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Tabelle2").Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlUp
    With Selection.Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Sheets("Tabelle3").Select
    Columns("B:B").Select
    Selection.Copy
    Columns("C:C").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        True, Transpose:=False
    Columns("B:B").Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlToLeft
    Columns("B:B").Select
    Selection.SpecialCells(xlCellTypeBlanks).Select
    Selection.Delete Shift:=xlToLeft
    Range("D25").Select
    ActiveWindow.ScrollColumn = 1
    Columns("A:A").ColumnWidth = 31.14
    Columns("A:A").Select
    Selection.Replace What:="1", Replacement:="100", LookAt:=xlWhole, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
        Selection.Replace What:="95% - 99%", Replacement:="Fuzzy 99 - 95", LookAt _
        :=xlWhole, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False _
        , ReplaceFormat:=False
    Selection.Replace What:="90% - 94%", Replacement:="Fuzzy 94 - 90", LookAt _
        :=xlWhole, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False _
        , ReplaceFormat:=False
    Selection.Replace What:="85% - 89%", Replacement:="Fuzzy 89 - 85", LookAt _
        :=xlWhole, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False _
        , ReplaceFormat:=False
    Selection.Replace What:="85% - 94%", Replacement:="Fuzzy 94 - 85", LookAt _
        :=xlWhole, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False _
        , ReplaceFormat:=False
    Selection.Replace What:="Project name:", Replacement:="Project:", LookAt:= _
        xlWhole, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="Repetitions", Replacement:="Internal Repetitions" _
        , LookAt:=xlWhole, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat _
        :=False, ReplaceFormat:=False
    Selection.Replace What:="Repetitons", Replacement:="Internal Repetitions", _
        LookAt:=xlWhole, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat _
        :=False, ReplaceFormat:=False
    Selection.Replace What:="Total words =", Replacement:="Total", LookAt:= _
        xlWhole, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="Kein match", Replacement:="Units not translated", _
        LookAt:=xlWhole, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat _
        :=False, ReplaceFormat:=False
    Selection.Replace What:="Kontext- und Struktur-match", Replacement:= _
        "Translated (paragraph context)", LookAt:=xlWhole, SearchOrder:=xlByRows, _
        MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
    Selection.NumberFormat = "@"
    Range("A18").Select
    ActiveCell.FormulaR1C1 = "100"
    Range("A19").Select
    Range("A31").Select
    Sheets("Tabelle3").Select
    ActiveWindow.SmallScroll Down:=39
    Range("A71").Select
    ActiveCell.FormulaR1C1 = "Pretranslated"
    Range("A72").Select
    ActiveCell.FormulaR1C1 = "Translated (structure context)"
    Range("A73").Select
    ActiveCell.FormulaR1C1 = "Check pretranslation"
    Range("B71").Select
    ActiveCell.FormulaR1C1 = "0"
    Range("B72").Select
    ActiveCell.FormulaR1C1 = "0"
    Range("B73").Select
    ActiveCell.FormulaR1C1 = "0"
    Range("B74").Select
    ActiveWindow.SmallScroll Down:=-36
    Range("A74").Select
    ActiveCell.FormulaR1C1 = "Source language:"
    Range("B74").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "=R[-58]C[-1]"
    Range("A74").Select
    ActiveCell.FormulaR1C1 = "Target language:"
    Cells.Select
    Range("A37").Activate
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("A49").Select
    ActiveWindow.SmallScroll Down:=-69
    Sheets("Tabelle1").Select
    Range("C4:D4").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-2],Tabelle3!C[-2]:C[-1],2,FALSE)"
    Range("C5:D5").Select
    ActiveCell.FormulaR1C1 = "FRANKE"
    Range("C6:D6").Select
    Selection.NumberFormat = "General"
    ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-2],Tabelle3!C[-2]:C[-1],2,FALSE)"
    Range("H6:I6").Select
    Selection.NumberFormat = "General"
    ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-3],Tabelle3!C[-7]:C[-6],2,FALSE)"
    Range("B15:M15,B17:M19").Select
    Range("M17").Activate
    Selection.NumberFormat = "General"
    Range("B15").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(ISNA(VLOOKUP(R[-1]C,Tabelle3!C1:C2,2,FALSE)),0,VLOOKUP(R[-1]C,Tabelle3!C1:C2,2,FALSE))"
    Range("B15").Select
    Selection.AutoFill Destination:=Range("B15:M15"), Type:=xlFillDefault
    Range("B15:M15").Select
    Range("B17").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "=R[-2]C"
    Range("B17").Select
    Selection.AutoFill Destination:=Range("B17:M17"), Type:=xlFillDefault
    Range("B17:M17").Select
    Range("G18").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "=R[-1]C"
    Range("G18").Select
    Selection.AutoFill Destination:=Range("G18:M18"), Type:=xlFillDefault
    Range("G18:M18").Select
    Selection.AutoFill Destination:=Range("G18:M19")
    Range("G18:M19").Select
    Range("A15").Select
    Selection.NumberFormat = "General"
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "=R[-11]C[2]"
    Cells.Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("A4:I10").Select
    Application.CutCopyMode = False
    Selection.NumberFormat = "@"
    Range("B15:M15,B17:M19").Select
    Range("M17").Activate
    Selection.NumberFormat = "0.00"
    Selection.NumberFormat = "0.0"
    Selection.NumberFormat = "0"
    Range("A15").Select
    Selection.NumberFormat = "@"
    Sheets("Tabelle3").Select
    Cells.Select
    Selection.Delete Shift:=xlUp
    Sheets("Tabelle1").Select
    Range("A14").Select

Dim Path As String
Dim filename As String
Path = "C:\Users\e.giai\Desktop\"
filename = Range("A15")
ActiveWorkbook.SaveAs filename:=Path & "Report_" & filename & ".xls", FileFormat:=xlXMLSpreadsheet
End Sub

非常感谢!

0 个答案:

没有答案