最近项目中经常遇到批量修改文档的情况,故尝试开始学习VBA
Sub documentsSet()
' On Error GoTo Error
Dim MyFile As String
Dim Arr(1000) As String
Dim count As Integer
ERRORCOUNT = 0
MyFile = Dir("C:\Users\liuhl\Desktop\新しいフォルダー\" & "*.xls") '批量修改文件所存在的文件夹地址
count = count + 1
Arr(count) = MyFile
Do While MyFile <> ""
MyFile = Dir
If MyFile = "" Then
Exit Do
End If
count = count + 1
Arr(count) = MyFile '将文件的名字存在数组中
Loop
For I = 99 To 150
Workbooks.Open Filename:="C:\Users\liuhl\Desktop\新しいフォルダー\" & Arr(I) '循环打开Excel文件
Sheets("画面項目").Select
For J = 12 To Sheets("画面項目").Range("A170").End(xlUp).Row
If Trim(Sheets("画面項目").Cells(J, 1)) = "特記" Then '将特定值以上的所有行目选中
lineCount = J - 1
Range("AD12:BG" & lineCount).Select
With Selection.Font '更改字体
.Name = "MS UI Gothic"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
Range("A1:D1").Select
Sheets("レビュー指摘一覧").Select
ActiveWindow.Zoom = 70
Range("A1").Select
End If
Next J
ActiveWorkbook.Close savechanges:=True '保存打开的文件
Next
'Error:
' Windows("新規 Microsoft Office Excel ワークシート.xlsx").Activate
' Sheets("Sheet2").Select
' Sheets("Sheet2").Cells(1 + 1, 1) = "誤りフェーイル:" & ERRORCOUNT
End Sub