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
    

      

  • 相关阅读:
    封装函数通过输入(元素,属性,目标值)改变div样式
    unicode键盘编码表
    js中的索引值
    JavaScript的三大组成部分
    阿望教你用vue写扫雷(超详细哦)
    关于换行以及换行属性
    html中的a标签详解
    利用GitHub Pages + jekyll快速搭建个人博客
    本博客文章转载,请注明出处
    git clone克隆项目太慢,或者直接导致克不下来的解决办法(转载请注明出处)
  • 原文地址:https://www.cnblogs.com/nextseven/p/7129066.html
Copyright © 2011-2022 走看看