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
    

      

  • 相关阅读:
    2014年之新年新愿
    C#解析Xml的Dom和Sax方式性能分析
    WCF协议与绑定
    使用SqlServer数据批量插入
    跨站脚本攻击XSS
    疯狂的JSONP
    SQLiteOpenHelper
    Android常用的UI布局
    Android用户界面
    ListView
  • 原文地址:https://www.cnblogs.com/nextseven/p/7129066.html
Copyright © 2011-2022 走看看