从零开始学习VBA（日记）

原創

2020-02-22 07:27

最近项目中经常遇到批量修改文档的情况，故尝试开始学习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