Sub 提取红色正确答案选项() Selection.HomeKey wdStory Selection.Find.ClearFormatting Selection.Find.Font.Color = wdColorRed Selection.Find.Replacement.ClearFormatting n = 0 With Selection.Find .Text = "" .Replacement.Text = "" .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchByte = True .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False Do While .Execute n = n + 1 Debug.Print n & "、" & RegGet(.Parent.Range.Text, "([ABCD])") Loop End With End Sub Function RegGet(ByVal OrgText As String, ByVal Pattern As String) As String Dim Regex As Object Dim Mh As Object Set Regex = CreateObject("VBScript.RegExp") With Regex .Global = True .Pattern = Pattern End With If Regex.test(OrgText) Then Set Mh = Regex.Execute(OrgText) RegGet = Mh.Item(0).submatches(0) Else RegGet = "" End If Set Regex = Nothing End Function