20181014xlVBA获取小题零分名单

Posted nextseven

tags:

篇首语:本文由小常识网(cha138.com)小编为大家整理,主要介绍了20181014xlVBA获取小题零分名单相关的知识,希望对你有一定的参考价值。

Sub GetZeroName()
    Dim Dic As Object
    Const SUBJECT = "科目名称"
    Dim Key As String
    Dim OneKey
    Dim Wb As Workbook
    Dim Sht As Worksheet
    Dim FolderPath As String
    Dim FileName As String
    Dim FilePath As String
    Dim wdApp As Object
    Dim wdDoc As Object
    
    Const StartCol = "G"
    Const EndCol = "X"
    Set Dic = CreateObject("Scripting.Dictionary")
    Set Wb = Application.ThisWorkbook
    FolderPath = Wb.Path & ""
    Set Sht = Wb.Worksheets(1)
    On Error Resume Next
    Set wdApp = GetObject(, "Word.Application")
    If wdApp Is Nothing Then
        Set wdApp = CreateObject("Word.Application")
    End If
    On Error GoTo 0
    
    With Sht
        EndRow = .Cells(.Cells.Rows.Count, 1).End(xlUp).Row
        For i = 2 To EndRow
            Key = .Cells(i, 3).Text
            Dic(Key) = ""
        Next
        
        
        
        For Each OneKey In Dic.Keys
            
            FileName = OneKey & "班" & SUBJECT & "小题零分名单.docx"
            On Error Resume Next
            wdApp.documents(FileName).Close
            On Error GoTo 0
            
            FilePath = FolderPath & FileName
            On Error Resume Next
            Kill FilePath
            On Error GoTo 0
            
            
            
            
            report = OneKey & "班" & SUBJECT & "小题零分名单" & vbCrLf
            For j = .Cells(1, StartCol).Column To .Cells(1, EndCol).Column
                
                ‘Key = OneKey & ";" & .Cells(1, j).Text
                report = report & vbCrLf & "【" & .Cells(1, j).Text & "】--------------------------------------------------------------------------------------------------------------" & vbCrLf & "    "
                For i = 2 To EndRow
                    If .Cells(i, 3).Text = OneKey Then
                        If .Cells(i, j).Value = 0 Then
                            report = report & .Cells(i, 2).Value & ";"
                        End If
                    End If
                Next i
            Next j
            ‘Debug.Print "__________________________________________________________________________________"
            ‘Debug.Print report
            
            Set wdDoc = wdApp.documents.Add
            wdDoc.SaveAs FilePath
            wdApp.Selection.typetext report
            wdDoc.Save
            wdDoc.Close
            
            
        Next OneKey
        
        
        
        
        
        
    End With
    
    wdApp.Quit
    Set Wb = Nothing
    Set Sht = Nothing
    Set wdApp = Nothing
    Set wdDoc = Nothing
End Sub

  

以上是关于20181014xlVBA获取小题零分名单的主要内容,如果未能解决你的问题,请参考以下文章

20171024xlVBA批量获取PPTWORDPDF页数

获取当天(今日)零点零分零秒

java 获取当天(今日)零点零分零秒

两个乒乓球队进行比赛,各出三人。甲队为a,b,c三人,乙队为x,y,z三人。 已抽签决定比赛名单。有人向队员打听比赛的名单。 a说他不和x比,c说他不和x,z比,请编程序找出三队赛手的名单。(代码片段

使用交叉验证分数获得零分

20190321xlVBA_明细信息表汇总成数据表