领导的代码--excel 宏

Sub Run()
    'read folder
    Dim mainFolderPath As String
    mainFolderPath = Application.ThisWorkbook.Sheets("Config").Range("csvFolder").Text
    
    'check folder's existance
    Dim fso As New FileSystemObject
    If Not fso.FolderExists(mainFolderPath) Then
        MsgBox "The csv folder """ & mainFolderPath & """ is not found," & vbNewLine & _
        "please check it & try again."
        Exit Sub
    End If
    
    'get the csv files list
    Dim csvFileList As New Collection
    For Each myFile In fso.GetFolder(mainFolderPath).Files
        If LCase(fso.GetExtensionName(myFile.Name)) = "csv" Then
            csvFileList.Add myFile.Path
        End If
    Next myFile
    
    'prepare new xlsx file
    Dim myBook As Workbook, mySheet As Worksheet
    Set myBook = Application.Workbooks.Add
    Set mySheet = myBook.Sheets(1)
    
    With mySheet
        
        'head lines
        .Cells(1, 2) = "Lang."
        .Cells(1, 3) = "File Name"
        .Cells(1, 4) = "Total"
        .Cells(1, 5) = "XTranslated"
        .Cells(1, 6) = "100% Matches"
        .Cells(1, 7) = "95% - 99%"
        .Cells(1, 8) = "85% - 94%"
        .Cells(1, 9) = "75% - 84%"
        .Cells(1, 10) = "50% - 74%"
        .Cells(1, 11) = "No Match"
        .Cells(1, 12) = "Repetitions"
        
        Dim i As Integer
        Dim re As New RegExp
        re.Pattern = "[a-z]{2}_[A-Z]{2}$"
        re.IgnoreCase = False
        re.Global = False
        Dim bn As String
        
        Dim cBook As Workbook
        Dim cSheet As Worksheet
        
        For i = 1 To csvFileList.Count
            'lang id
            bn = fso.GetBaseName(csvFileList(i))
            If re.Test(bn) Then
                Set matches = re.Execute(bn)
                .Cells(i + 1, 2) = matches(0)
            End If
            
            'file name
            .Cells(i + 1, 3) = fso.GetFileName(csvFileList(i))
            
            'data
            Set cBook = Application.Workbooks.Open(csvFileList(i))
            Set cSheet = cBook.Sheets(1)
            
            'check head line
            Dim head As String
            head = cSheet.Cells(1, 5).Text
            Dim n As Integer
            n = cSheet.UsedRange.Rows.Count
            Dim srcRange As Range, destRange As Range
            If head = "100%" Then 'mode 1
                Set srcRange = cSheet.Range(cSheet.Cells(n, 3), cSheet.Cells(n, 11))
                Set destRange = .Range(.Cells(i + 1, 4), .Cells(i + 1, 12))
                destRange.Value = srcRange.Value
                
            ElseIf head = "Repetition" Then 'mode 2
                
                'Total & XT
                Set srcRange = cSheet.Range(cSheet.Cells(n, 3), cSheet.Cells(n, 4))
                Set destRange = .Range(.Cells(i + 1, 4), .Cells(i + 1, 5))
                destRange.Value = srcRange.Value
                
                '100%-0%
                Set srcRange = cSheet.Range(cSheet.Cells(n, 6), cSheet.Cells(n, 11))
                Set destRange = .Range(.Cells(i + 1, 6), .Cells(i + 1, 11))
                destRange.Value = srcRange.Value
                
                'repetition
                .Cells(i + 1, 12) = cSheet.Cells(n, 5)
                
            ElseIf head = "Repetitions" Then 'mode 3
                
                'Total
                .Cells(i + 1, 4) = cSheet.Cells(n, 11)
                
                'XT & 100%
                Set srcRange = cSheet.Range(cSheet.Cells(n, 3), cSheet.Cells(n, 4))
                Set destRange = .Range(.Cells(i + 1, 5), .Cells(i + 1, 6))
                destRange.Value = srcRange.Value
                
                '99%-0%
                Set srcRange = cSheet.Range(cSheet.Cells(n, 6), cSheet.Cells(n, 10))
                Set destRange = .Range(.Cells(i + 1, 7), .Cells(i + 1, 11))
                destRange.Value = srcRange.Value
                
                'repetition
                .Cells(i + 1, 12) = cSheet.Cells(n, 5)
            
            Else
                MsgBox "The head line of file """ & vbNewLine & _
                csvFileList(i) & """ is not as required." & vbNewLine & _
                "The file is skipped.", vbExclamation + vbOKOnly, "Handler"
            End If
            
            cBook.Close
            
        Next i
        
        'merge cells
        .Range(.Cells(2, 1), .Cells(i, 1)).Merge
        
        '首行着色并加粗
        Range("A1:L1").Interior.ColorIndex = 34
        Range("A1:L1").Font.Bold = "True"
        
        '表格框线
        .UsedRange.Borders.LineStyle = xlContinuous
        
        'table
        Dim rng As Range
        
        'copy data transposely
        Set rng = Union(.Range(.Cells(1, 2), .Cells(i, 2)), _
                        .Range(.Cells(1, 5), .Cells(i, 12)))
        rng.Copy
        i = i + 3
        .Cells(i, 2).PasteSpecial Transpose:=True
        
        'move repetition line
        .Cells(i + 2, 3).EntireRow.Insert
        .Range(.Cells(i + 9, 2), .Cells(i + 9, i - 2)).Cut .Cells(i + 2, 2)
        
        'insert summary line
        .Cells(i + 6, 3).EntireRow.Insert
        .Cells(i + 6, 2) = "< 85%"
        .Cells(i + 6, 3).FormulaR1C1 = "=sum(R[1]C:R[3]C)"
        .Range(.Cells(i + 6, 3), .Cells(i + 6, i - 2)).FillRight
        .Range(.Cells(i + 6, 3), .Cells(i + 6, i - 2)).Copy
        .Cells(i + 6, 3).PasteSpecial xlPasteValues
        
        'delete last 3 lines
        .Cells(i + 7, 2).EntireRow.Delete
        .Cells(i + 7, 2).EntireRow.Delete
        .Cells(i + 7, 2).EntireRow.Delete
        
        
        '冻结窗口
        'Range("B2").Select
        'ActiveWindow.FreezePanes = True
    
        '自动筛选
        '.Range("A1").AutoFilter
        
        '定位到 A2
        .Range("A2").Select
    
        
    End With
    
    'cBook.Save
    MsgBox "Done", vbOKOnly + vbInformation, "Handler"
    
End Sub