匹配带下划线的单元格值并返回正确的答案和其他语言问题

我在我头上，希望有人能帮上忙。 我search了，找不到所有不同的部分放在一起…

很确定在解决scheme中需要VBA。

情况是这样的：我已经递交了一个用日文和英文写的10K长的多选表单。 它有一个问题的列，写出来的答案，然后单独列5个多项select的每个选项。

Question | writAnswer| MCoice1| MChoice2 | MChoice3 | MChoice4 | MChoice5 

我希望从这份名单中产生的是另外一个专栏，它给出了多种select是正确的。 听起来很简单，对吧？ 那是我想到的，直到我开始，并没有太多太复杂，在复杂性暴涨之前。

问题1：多种语言。
至less这是我认为在这里发生的事情。 当我对日文文本运行SEARCHfunction时：

 "私は= I" (the "I" is underlined in my original document) 

使用其中一个Mchoice单元格中的“I”，它将返回一个错误。 看起来他们用日文字体写出原始问题，然后用英文字体写出答案。

我用你能想象的方式来玩这个公式，所以我相当肯定这不是一个id10t的错误..但你永远不知道..

问题2：多个正确的答案与“哑”search。

所有的wAnswers都有完整的答案，图片就是这样的一个例子：

  I am a teacher. (The 'a' is underlined in the original document) 

下划线表示学生将从MChoice选项中select字母“a”。 但是，其他MChoice字段包括“I”，“am”和“a”，如果直接searchstring是否位于wAnswer字段，则匹配。

所以，这个posAnswer列将返回MChoice回答正确的数字。 如果Mchoice1中的答案是正确的，则需要“1”，如果方法2正确，则返回2，以此类推5列。

问题3：错误捕获。

最后但并非最不重要的是，在“检查我”这个函数中有一些逻辑是很棒的。 或者如果没有（0）正确的答案或者不止一个正确的答案，那么沿着这些方向。

所有这些问题都应该有一个正确的答案。

这是我所能做的最好的描述。 我相信会有后续的问题，但是我非常感谢你阅读这个，并试图帮助我！

更新/编辑以回应下面的@ xidgel提供的解决scheme：@xidgel您的解决scheme几乎是我所要找的东西。 已经为我节省了大量的时间。 如果我可以要求一个调整，它仍然可以减less大量的时间这个任务，这是一个问题的照片：

答案字段的答案是下划线的，但是创build这个答案的老师也在这个单词旁边加了空格。 因为这个函数返回'FALSE'，我不得不手动修复答案字段。 有数百个，如果不是数以千计的情况下，前面或后面的空格也是下划线的。 可以调整function来解决这个问题吗？

Answer 1

这里是用户定义函数的代码，可能有帮助。

 Public Function IsUnderlineMatch( _ ByRef LookFor As Excel.Range, _ ByRef LookIn As Excel.Range) As Boolean ' Loops through the underlined text in LookIn ' then tests to see if it matches LookFor. ' Returns True if a match is found. Dim StartAt As Long Dim ULText As String Dim ULStart As Long Dim ULEnd As Long IsUnderlineMatch = False StartAt = 1 Do While StartAt <= LookIn.Characters.Count And _ GetUnderlinedPart(LookIn, StartAt, ULText, ULStart, ULEnd) If StrComp(Trim(ULText), Trim(LookFor.Characters.Text), vbTextCompare) = 0 Then IsUnderlineMatch = True Exit Do Else StartAt = ULEnd + 1 End If Loop End Function Public Function GetUnderlinedPart( _ ByRef r As Excel.Range, _ ByVal StartAt As Long, _ ByRef UnderlinedStr As String, _ ByRef UnderlineStart As Long, _ ByRef UnderlineEnd As Long) As Boolean ' Searches r for the first group of ' consecutive characters that are underlined. ' Search starts at StartAt ' Returns True if underlined chars were found, ' otherwise returns False ' On return: ' UnderlinedStr holds the chars that were underlined. ' UnderlineStart and UnderlineEnd hold the indices ' of the start and end of the underlined portion. ' If no underlining is found, on return: empty string ' UnderlinedStr holds an empty string. ' UnderlineStart and UnderlineEnd are 0 Dim I As Long ' Find first underlined char I = StartAt Do While I <= r.Characters.Count And _ r.Characters(I, 1).Font.Underline = xlUnderlineStyleNone I = I + 1 Loop ' Handle no underline found If I > r.Characters.Count Then UnderlineStart = 0 UnderlineEnd = 0 UnderlinedStr = "" GetUnderlinedPart = False Exit Function End If UnderlineStart = I ' Find end of contiguous underlined chars I = UnderlineStart Do While I <= r.Characters.Count And _ r.Characters(I, 1).Font.Underline <> xlUnderlineStyleNone I = I + 1 Loop UnderlineEnd = I - 1 UnderlinedStr = _ r.Characters(UnderlineStart, UnderlineEnd - UnderlineStart + 1).Text GetUnderlinedPart = True End Function 

要在你的Excel工作表中使用它，请执行以下操作：

 =IsUnderlineMatch(MChoice,Answer) 

该函数将返回True，下划线文本中的答案与MChoice完全匹配; 否则会返回False。 您可以testing多个MChoice的答案。

笔记：

（A）此代码通过逐个查看字符来testing下划线。 我以前做过（在Word IIRC中），而且速度很慢。 我不知道通过10000行需要多长时间。

（B）如果加下划线的文字是英文/ Ascii，我相信这会起作用。 如果加下划线的文字是日文， 可能会有效，但是我没有处理Unicode的经验，也不知道陷阱的位置。 您可能需要调整，以使其与非Ascii工作。

希望有所帮助