zoukankan      html  css  js  c++  java
  • 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
    

      

  • 相关阅读:
    Kmp 加深理解 之 poj 3461
    Kmp 模板 之 hdu 1711 Number Sequence
    最大连续子序列和(经典DP) 之 hdu 1231 最大连续子序列
    数学 之 hdu 4710 Balls Rearrangement
    01背包变形 之 hdu 2126 Buy the souvenirs
    逆序数 之 hdu 1394 Minimum Inversion Number
    根据进程文件id查看所有进程信息
    N皇后问题
    17. 电话号码的字母组合
    697. 数组的度
  • 原文地址:https://www.cnblogs.com/nextseven/p/9785566.html
Copyright © 2011-2022 走看看