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获取小题零分名单的主要内容,如果未能解决你的问题,请参考以下文章
两个乒乓球队进行比赛,各出三人。甲队为a,b,c三人,乙队为x,y,z三人。 已抽签决定比赛名单。有人向队员打听比赛的名单。 a说他不和x比,c说他不和x,z比,请编程序找出三队赛手的名单。(代码片段