zoukankan      html  css  js  c++  java
  • 20170706wdVBA正则表达式提取题目

    Public Sub GetContents()
        Dim Reg As Object
        Dim Matches As Object
        Dim OneMatch As Object
        Dim Index As Long
        Dim TimeStart As Variant
        TimeStart = VBA.Timer
        Set Reg = CreateObject("Vbscript.RegExp")
        With Reg
            .Pattern = "^s*?((?:[^
    ]*?d+题[^
    ]?s*?[^
    ]*?s*?)?d*[.,、.](?:[^
    ]*?
    ?[
    ]+?){1,4}?)s*?" & _
                       "(A[.,、.].*?)s+?" & _
                       "(B[.,、 .].*?)s+?" & _
                       "(C[.,、.].*?)s+?" & _
                       "(D[.,、.].*?)s*?" & "
    ?[
    ]+"
            .MultiLine = True
            .Global = True
            .IgnoreCase = False
        End With
    
        Dim FilePath As String
        With Application.FileDialog(msoFileDialogFilePicker)
            .AllowMultiSelect = False
            .InitialFileName = ActiveDocument.Path
            .Title = "请选择单个Excel工作簿"
            .Filters.Clear
            .Filters.Add "Excel工作簿", "*.xls*"
            If .Show = -1 Then
                FilePath = .SelectedItems(1)
            Else
                MsgBox "您没有选中任何文件夹,本次汇总中断!"
                Exit Sub
            End If
        End With
    
        Dim xlApp As Object
        Dim wb As Object
        Dim sht As Object
        Dim StartRow As Long
        Dim StartIndex As Long
    
        Set xlApp = CreateObject("Excel.Application")
        Set wb = xlApp.workbooks.Open(FilePath)
        Set sht = wb.worksheets.Add(After:=wb.worksheets(wb.worksheets.Count))
        sht.Name = "提取记录" & wb.worksheets.Count - 1
        sht.Range("A1:H1").Value = Array("储存序号", "引言题干", "A选项", "B选项", "C选项", "D选项", "正确答案", "配图名称")
    
        With sht
            StartRow = .Range("A65536").End(3).Row
            StartIndex = StartRow - 1
    
            Set Matches = Reg.Execute(ActiveDocument.Content.Text)
            Index = 0
            For Each OneMatch In Matches
                Index = Index + 1
                ''Debug.Print "Question Index  " & N & "   :   " '; OneMatch
                For i = 0 To OneMatch.submatches.Count - 1
                    .Cells(StartRow + Index, 1).Value = StartIndex + Index
                    .Cells(StartRow + Index, 2).Value = OneMatch.submatches(0)
                    .Cells(StartRow + Index, 3).Value = OneMatch.submatches(1)
                    .Cells(StartRow + Index, 4).Value = OneMatch.submatches(2)
                    .Cells(StartRow + Index, 5).Value = OneMatch.submatches(3)
                    .Cells(StartRow + Index, 6).Value = OneMatch.submatches(4)
                    'If i <> 0 Then
                    'Debug.Print ">>>>Option Index"; i; "  :   "; OneMatch.submatches(i)
                    'Else
                    '  Debug.Print ">>>>Question Index  0 "; "  :   "; OneMatch.submatches(i)
                    ' End If
                Next i
                ' If N = 17 Then Exit For
            Next
    
            With .usedrange
                .HorizontalAlignment = xlGeneral
                .VerticalAlignment = xlCenter
                .WrapText = True
            End With
    
            If ShowPicName Then xlApp.WorksheetFunction.Transpose (PicName)
    
            .usedrange.Columns.AutoFit
        End With
    
    
        wb.Close True
        xlApp.Quit
        Set sht = Nothing
        Set wb = Nothing
        Set xlApp = Nothing
    
        Debug.Print VBA.Timer - TimeStart; "秒"
        Set Reg = Nothing
    End Sub
    

      

  • 相关阅读:
    构建自己的C/C++插件开发框架(四)——核心层设计和实现
    构建自己的C/C++插件开发框架(二)——总体功能
    对企业来说,要放在第一位的是什么
    深入理解C++的动态绑定和静态绑定
    构建自己的C/C++插件开发框架(三)——总体结构
    管道和过滤器
    层模式——面向模式的体系结构学习笔记
    使用信元流(TLVStream)规范、简化模块(C/C++)间交互
    推荐博客
    Android 操作系统的内存回收机制
  • 原文地址:https://www.cnblogs.com/nextseven/p/7129066.html
Copyright © 2011-2022 走看看