3.3-代码

初学者，建议将以下代码打印出来，拿出笔一行一行去看，当然后文我们一是一行一行解读的

Sub S01_初始化()
    ' 清空 工作表操作界面 上次遗留的信息
    Set shtFirst = ThisWorkbook.Worksheets("操作界面")
    maxRow = shtFirst.Cells(Rows.Count, "B").End(xlUp).Row
    If maxRow > 2 Then
        shtFirst.Range("A2:C" & maxRow).ClearContents
    End If
    shtFirst.Range("K2:K4").ClearContents
    
    '清空 工作表数据缓存 所有信息
    Set shtData = ThisWorkbook.Worksheets("数据缓存")
    shtData.Cells.ClearContents
    
    shtFirst.Range("K2") = "已点击"

End Sub

Sub S02_读入数据()
    Dim longName As String
    Dim shortName As String
    Dim selectFile
    Dim fso
    Dim shtFirst
    
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set shtFirst = ThisWorkbook.Worksheets("操作界面")
    
    With Application.FileDialog(msoFileDialogOpen)
        .Title = "选择文件"
        .AllowMultiSelect = True
        .Filters.Clear
        .Filters.Add "Excel文件", "*.xlsx"
        .FilterIndex = 2  '默认的文件筛选条件的索引号
        .InitialFileName = ThisWorkbook.Path & "\" & "【1】输入"
        .Show
        
        For Each selectFile In .SelectedItems
            longName = selectFile
            shortName = fso.GetFile(longName).Name
            Call S0201_文件处理(longName, shortName)
        Next
    End With
    
    shtFirst.Range("K3") = "已点击"
End Sub

Sub S0201_文件处理(longName, shortName)
    Set wb = Workbooks.Open(longName) '打开工作簿
    Set sht = wb.Worksheets(1)
    '获取员工姓名
    employeeName = Split(shortName, "-")(0)
    Debug.Print (employeeName)
    '获取输入Excel最大行
    maxRow = sht.Cells(Rows.Count, "B").End(xlUp).Row
    
    ' 拟输入列列号
    Set shtData = ThisWorkbook.Worksheets("数据缓存")
    a1Value = shtData.Range("A1")
    If a1Value = "" Then
        inputCol = 1
    Else
        inputCol = shtData.Cells(1, Columns.Count).End(xlToLeft).Column + 1
    End If
    
    shtData.Cells(1, inputCol) = employeeName
    
    ' 复制每个员工的数据至目标工作表
    sht.Range("B2:B" & maxRow).Copy Destination:=shtData.Cells(2, inputCol)

    wb.Close
End Sub

Sub S03_计算()
    Set shtFirst = ThisWorkbook.Worksheets("操作界面")
    up_tol = shtFirst.Range("K8")
    down_tol = shtFirst.Range("K9")
    
    Set shtData = ThisWorkbook.Worksheets("数据缓存")
    
    maxCol = shtData.Cells(1, Columns.Count).End(xlToLeft).Column
    
    inputRow = 2

    ' 对数据缓存工作表数据按列遍历，每列按照行遍历
    For j = 1 To maxCol Step 1
        maxRow = shtData.Cells(Rows.Count, j).End(xlUp).Row
        qualifiedCount = 0
        totalCount = 0
        employeeName = shtData.Cells(1, j)
        
        For i = 2 To maxRow Step 1
            weightValue = shtData.Cells(i, j)
            If weightValue <= up_tol And weightValue >= down_tol Then
                qualifiedCount = qualifiedCount + 1
            End If
            
            totalCount = totalCount + 1
        Next i
        
        qualifiedRate = Round(qualifiedCount / totalCount, 3)
        
        ' 写入数据
        shtFirst.Cells(inputRow, "A") = inputRow - 1
        shtFirst.Cells(inputRow, "B") = employeeName
        shtFirst.Cells(inputRow, "C") = qualifiedRate
        
        inputRow = inputRow + 1
        
    Next j
    
    shtFirst.Range("K4") = "已点击"
End Sub

以上代码在一个模块中，如图3-5所示，共有4个Sub构成，分别如下。

S01_初始化()

Sub S02_读入数据()

S0201_文件处理(longName, shortName)

S03_计算()

操作界面按钮关联其中的S01/S02/S03即可，其中S0201在S02中进行调用。

---

图3-5 VBE中的VBA代码位置