我创建了一个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
非常感谢!