Question

我们说我在一个单元格中有以下字符串：

电子。 Stark，T。Lannister，A。Martell，P Baelish，B。Dondarrion和J. Mormont。整个维斯特洛的裸露水平增加，导致其零星的季节性气候。纳特。 PROC。 ACA。科学。（2011）3：142-149。

我想从中提取标题。我正在考虑的方法是编写一个脚本，说明＆＃34;从这个字符串中拉出文本，但前提是它长度超过50个字符。＆＃34;这样它只返回标题，而不是像＃34;斯塔克，T＆＃34;和＆＃34;马爹利，P＆＃34;。我到目前为止的代码是：

Sub TitleTest()
    Dim txt As String
    Dim Output As String
    Dim i As Integer
    Dim rng As Range
    Dim j As Integer
    Dim k As Integer

    j = 5
    Set rng = Range("A" & j) 'text is in cell A5
    txt = rng.Value 'txt is string
    i = 1

    While j <= 10 'there are five references between A5 and A10
    k = InStr(i, txt, ".") - InStr(i, txt, ". ") + 1 'k is supposed to be the length of the string returned, but I can't differenciate one "." from the other.

    Output = Mid(txt, InStr(i, txt, "."), k)
            If Len(Output) < 100 Then
                i = i + 1
            ElseIf Len(Output) > 10 Then
                Output = Mid(txt, InStr(i, txt, "."), InStr(i, txt, ". "))
                Range("B5") = Output
                j = j + 1
            End If
    Wend
End Sub

当然，如果不是两个＆＃34;这将很有效。＆＃34;我试图从中获取完整的信息。有没有办法以这样的方式编写InStr函数，以至于它不会两次找到相同的字符？我是以错误的方式解决这个问题吗？

提前致谢，

编辑：另一种可行的方法（如果可能的话），就是如果我可以有一个角色是＆＃34; any lower case letter＆＃34。和＆＃34;。＆＃34;。这有可能吗？我无法找到如何实现这一目标的任何例子......

Answer 1

在这里，它完全按照您的意愿运作。从您的代码来看，我确信您可以很快地根据您的需求进行调整：

Option Explicit

Sub ExtractTextSub()

    Debug.Print ExtractText("E. Stark, T. Lannister, A. Martell, P Baelish, B. Dondarrion, and J. Mormont. Increased levels of nudity across Westeros contributes to its sporadic seasonal climate. Nat. Proc. Aca. Sci. (2011) 3: 142-149.")

End Sub

Public Function ExtractText(str_text As String) As String

    Dim arr         As Variant
    Dim l_counter   As Long
    arr = Split(str_text, ".")

    For l_counter = LBound(arr) To UBound(arr)

        If Len(arr(l_counter)) > 50 Then
            ExtractText = arr(l_counter)
        End If

    Next l_counter

End Function

编辑：5票在任何时候都让我改进了我的代码:)这将返回最长的字符串，而不考虑50个字符。此外，在错误处理程序和点的常量。另外在提取物的末尾添加一个点。

Option Explicit

Public Const STR_POINT = "."

Sub ExtractTextSub()

    Debug.Print ExtractText("E. Stark, T. Lannister, A. Martell, P Baelish, B. Dondarrion, and J. Mormont. Increased levels of nudity across Westeros contributes to its sporadic seasonal climate. Nat. Proc. Aca. Sci. (2011) 3: 142-149.")

End Sub

Public Function ExtractText(str_text As String) As String

    On Error GoTo ExtractText_Error

    Dim arr             As Variant
    Dim l_counter       As Long
    Dim str_longest     As String

    arr = Split(str_text, STR_POINT)

    For l_counter = LBound(arr) To UBound(arr)

        If Len(arr(l_counter)) > Len(ExtractText) Then
            ExtractText = arr(l_counter)
        End If

    Next l_counter

ExtractText = ExtractText & STR_POINT

On Error GoTo 0
Exit Function

ExtractText_Error:

MsgBox "Error " & Err.Number & Err.Description 

End Function

使用VBA从两个相同字符之间的字符串中提取文本

1 个答案: