补充几个Excel宏

 

'统计不同类型的实验项目的个数，并将数据拷贝到剪贴板方便使用，在使用时需要在“工程|引用”菜单中添加fm20.dll

Sub CountCells()
    Dim cell As Object
    Dim str As String
    Dim count, bcount, zcount, rcount As Integer
    Dim objData As DataObject
   
    count = 0
    bcount = 0
    zcount = 0
    rcount = 0
    Set objData = New DataObject
   
    For Each cell In Selection
        str = cell.Value
        If str = 基本" Then
            bcount = bcount + 1
        ElseIf str = 综合设计" Then
            zcount = zcount + 1
        ElseIf str = "研究" Then
            rcount = rcount + 1
        End If
        count = count + 1
    Next cell
   
    objData.SetText count & vbTab & bcount & vbTab & zcount & vbTab & rcount
    objData.PutInClipboard
End Sub

'填充选择的区域中的空白单元格为0
Sub FillCells()
    Dim cell As Object
    For Each cell In Selection
       If cell.Value = "" Then
        cell.Value = 0
       End If
    Next cell
End Sub

'替换选择区域中的单元格内容为指定内容

Sub ReplaceCells()
    Dim cell As Object
    For Each cell In Selection
       If Left(cell.Value, 2) = "验证" Or Left(cell.Value, 2) = "演示" Or Left(cell.Value, 2) = "基本" Then
        cell.Value = "基本"
       ElseIf Left(cell.Value, 2) = "综合" Or Left(cell.Value, 2) = "设计" Then
        cell.Value = "综合设计"
       Else
        cell.Value = "研究"
       End If
    Next cell
End Sub