Question

我在我头上，希望有人可以提供帮助。我已经搜索过，无法找到所有不同的部分拼凑在一起......

非常确定解决方案中需要VBA。

情况是这样的：我已经递交了一份10k长的多选电子表格，该电子表格是用日语和英语写的。它有一个问题列，写出的答案，然后是5个多项选择中每个选项的单独列。

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

我希望从此列表中产生的是另一列，它给出了多项选择正确选择的数量。听起来很简单吧？这就是我的想法直到我开始并且在复杂性飙升之前没有走得太远。

问题1：多种语言。
至少我认为这是在发生什么。当我针对日文文本运行SEARCH函数时：

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

使用＆＃39; I＆＃39;在其中一个Mchoice单元格中，它返回错误。看起来他们用日语字体写了原始问题，然后用英文字体写了答案。

我已经按照你想象的方式玩了这个公式，所以我相当肯定它不是id10t错误..但你永远不会知道......

问题2：使用“愚蠢”的多个正确答案。搜索范围。

所有的wAnswers都写出了完整的答案，pic有一个例子：

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

下划线表示学生要选择字母＆＃39; a＆＃39;来自MChoice选项。但是，其他MChoice字段包括＆＃34; I＆＃34;，＆＃34; am＆＃34;和＆＃34; a＆＃34;如果直接搜索该字符串是否在wAnswer字段中，则匹配。

因此，此posAnswer列将返回MChoice答案正确的数字。如果Mchoice1中的答案是正确的，那么＆＃39; 1＆＃39;如果Mchoice 2正确，则返回2，对于5列，依此类推。

问题3：错误捕获。

最后但并非最不重要的是，在函数中使用一些逻辑来表示“检查我！”＃39;如果没有（0）正确的答案或一个以上的问题的正确答案，那么沿着这些方向行事。

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

这是我能说出来的最好的描述。我确定会有跟进问题，但我感谢你阅读这篇文章并试图帮助我！

更新/修改以响应以下@xidgel提供的解决方案： @xidgel你的解决方案对我正在寻找的东西几乎是贪婪的。已经为我节省了大量时间。如果我可以要求进行一次调整，它仍然可以减少很多时间来完成这项任务，这里有一个问题：

＆＃34;答案＆＃34;字段的答案有下划线，但创建此字段的老师也强调了该字旁边的空格。因此，这个功能正在返回“FALSE＆＃39;我必须手动修复“答案”字段。在工作表上有数百个（如果不是数千个）实例，其中前后的空格也加下划线。可以调整功能以解决这个问题吗？

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。您可以针对答案测试多个MChoice。

注意：

（A）此代码通过一次查看一个字符来测试下划线。我之前（在Word IIRC中）已经完成了这个并且它非常慢。我不知道要经过10000行需要多长时间。

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

希望有所帮助

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

1 个答案: