VBA注释临时

Sub shishi() '按ABCDE为多选题定义答案;
'A．沙利度胺 B．异烟肼   C．利福平
'd.氯法齐明 E.氨苯砜
'46．各型麻风病的首选药物为(D)
'A．沙利度胺 B．异烟肼   C．利福平
'd.氯法齐明 E.氨苯砜
'45．各型麻风病的首选药物为(E)
'A．沙利度胺 B．异烟肼   C．利福平
'd.氯法齐明 E.氨苯砜
'45645
'1532131
'46．各型麻风病的首选药物为(D)Dim mt, mh, mk, oRng As Range, rg As Range, n&, m&, str$, d, rng As Range ',tSet d = CreateObject("Scripting.Dictionary")y = 4With CreateObject("vbscript.regexp").Global = True: .IgnoreCase = False: .MultiLine = True.Pattern = "^\d+．[^\r]+\(([A-E])\)\r(?:(?!^\d+．[^\r]+\((?:[A-E])\)\r).)+" '匹配题干+选项(非题干的多行,直到第二个题干前),有几个就有多少组For Each mt In .Execute(ActiveDocument.Content)y = y + 1 '这个是初始的题号;m = mt.FirstIndex: n = mt.Length45.各型麻风病的首选药物为(E)Set oRng = ActiveDocument.Range(m, m + n) 'orng为题干+选项;str = mt.submatches(0) 'str为题干后答案;.Pattern = "([A-E]．)((?:(?![A-E]．).)+)" '匹配ABCDE选项;For Each mh In .Execute(oRng.Text)m = mh.FirstIndex: n = mh.LengthSet rg = ActiveDocument.Range(oRng.Start + m, oRng.Start + m + n) 'rg为具体选项;Set d(Left(rg.Text, 1)) = rg '在字典内创建A与A选项内容间的对应;Nextt = d.items 'item只能有5个,对应A-E5个选项,即t(0)-t(4);Select Case y Mod 5 '是5的倍数则分配A,余数为1则分配B,其他以此类推;4为E;Case 0If str <> "A" Then.Pattern = "\(\s*[A-E]\s*\)"For Each mk In .Execute(oRng.Text)m = mk.FirstIndex: n = mk.LengthSet rng = ActiveDocument.Range(oRng.Start + m, oRng.Start + m + n) '通常二次正则查找时需要用到加两次;With rng.MoveStart 1, 1: .MoveEnd 1, -1: .Text = "A" '这个就是从括号外移动到括号内;End WithNextWith d(str) '字典直指Range对象(遥控);.MoveStart 1, 2: .MoveEnd 1, -1: s1 = .Text '起点向后移动2,末点向前移动1；End WithWith t(0) '这里写成d.itme(1)是否可行？AHK中必须写成那样;.MoveStart 1, 2: .MoveEnd 1, -1: s2 = .Text.Text = s1End Withd(str).Text = s2End If '上面就是交换两个选项内容,而选项自身不变;Case 1 '余下的都是重复性操作了,真正核心的也就是上面的代码部分了;If str <> "B" Then.Pattern = "\(\s*[A-E]\s*\)"For Each mk In .Execute(oRng.Text)m = mk.FirstIndex: n = mk.LengthSet rng = ActiveDocument.Range(oRng.Start + m, oRng.Start + m + n)With rng.MoveStart 1, 1: .MoveEnd 1, -1: .Text = "B"End WithNextWith d(str).MoveStart 1, 2: .MoveEnd 1, -1: s1 = .TextEnd WithWith t(1).MoveStart 1, 2: .MoveEnd 1, -1: s2 = .Text.Text = s1End Withd(str).Text = s2End IfCase 2If str <> "C" Then.Pattern = "\(\s*[A-E]\s*\)"For Each mk In .Execute(oRng.Text)m = mk.FirstIndex: n = mk.LengthSet rng = ActiveDocument.Range(oRng.Start + m, oRng.Start + m + n)With rng.MoveStart 1, 1: .MoveEnd 1, -1: .Text = "C"End WithNextWith d(str).MoveStart 1, 2: .MoveEnd 1, -1: s1 = .TextEnd WithWith t(2).MoveStart 1, 2: .MoveEnd 1, -1: s2 = .Text.Text = s1End Withd(str).Text = s2End IfCase 3If str <> "D" Then.Pattern = "\(\s*[A-E]\s*\)"For Each mk In .Execute(oRng.Text)m = mk.FirstIndex: n = mk.LengthSet rng = ActiveDocument.Range(oRng.Start + m, oRng.Start + m + n)With rng.MoveStart 1, 1: .MoveEnd 1, -1: .Text = "D"End WithNextWith d(str).MoveStart 1, 2: .MoveEnd 1, -1: s1 = .TextEnd WithWith t(3).MoveStart 1, 2: .MoveEnd 1, -1: s2 = .Text.Text = s1End Withd(str).Text = s2End IfCase 4If str <> "E" Then.Pattern = "\(\s*[A-E]\s*\)"For Each mk In .Execute(oRng.Text)m = mk.FirstIndex: n = mk.LengthSet rng = ActiveDocument.Range(oRng.Start + m, oRng.Start + m + n)With rng.MoveStart 1, 1: .MoveEnd 1, -1: .Text = "E"End WithNextWith d(str).MoveStart 1, 2: .MoveEnd 1, -1: s1 = .TextEnd WithWith t(4).MoveStart 1, 2: .MoveEnd 1, -1: s2 = .Text.Text = s1End Withd(str).Text = s2End IfEnd Selectd.RemoveAllNextEnd With
End Sub