从两个单元格中提取部分匹配文本

分享于 

10分钟阅读

电脑

 

问题:

我正在寻找一个解决方案,用于比较两个细胞的文本,并仅提取 MATCH的两个细胞的部分。 例如:

单元格 A1:"昨天我吃了一个苹果"单元格 A2: 今天我吃了橙色"

如何将"我吃了"提取到另一个单元格中?

有人有一个用户定义的函数,我可以插入 VBA,或者是否有一种使用现有函数的方法。


回答 1:

enter image description here

我想建议两个不同的公式,将从单元格中的文本字符串中提取"我吃了 。"。

  • A2,A3 & A4 公式,其中 ,前一个单词。

    
    =TRIM(MID(A2,FIND(CHAR(1),SUBSTITUTE(A2,"",CHAR(1),1))+1,FIND(CHAR(1),SUBSTITUTE(A2,"",CHAR(1),4))-FIND(CHAR(1),SUBSTITUTE(A2,"",CHAR(1),2))+2))
    
    
    
    
  • A7 公式,其中 "我吃了",前面有两个单词。

    
    =TRIM(MID(A7,FIND(CHAR(1),SUBSTITUTE(A7,"",CHAR(1),1))+6,FIND(CHAR(1),SUBSTITUTE(A7,"",CHAR(1),3))-FIND(CHAR(1),SUBSTITUTE(A7,"",CHAR(1),1))+2))
    
    
    
    

工作方式:

FIND(CHAR(1),SUBSTITUTE(A2,"",CHAR(1),4))

返回 19,它是搜索字符串的Start Position,我吃了


FIND(CHAR(1),SUBSTITUTE(C7,"",CHAR(1),4))-FIND(CHAR(1),SUBSTITUTE(C7,"",CHAR(1),2))+1



返回 8。我吃了 ( 包括空格)的


FIND(CHAR(1),SUBSTITUTE(A2,", CHAR(1),2))+2



返回 14 & 我吃一个苹果


FIND(CHAR(1),SUBSTITUTE(C7,"",CHAR(1),4))-FIND(CHAR(1),SUBSTITUTE(C7,"",CHAR(1),2))+2



返回 9 减去 14-9 = 5,从苹果 removes

生成公式:


=MID(C7,FIND(CHAR(1),SUBSTITUTE(C7,"",CHAR(1),1))+1,8)



回报,我吃了 ,期望答案。


回答 2:

下面是我写的基本单词解析,然后根据 MATCH 序列的字符数查找最长的单词 MATCH。


' LongestMatch - compares two Strings for the longest common sequence


' of words in terms of the word sequence character count.


' Make the comparison case insensitive with a third argument


' (optional) set to True. The words from String1 are returned.


'


' Authored by Ted Dillard


'


' Spaces, Tabs and the Punctuation2Space characters delimit the words


' in the comparison; only whole word matches are returned.


'


' Punctuation Indifference: Two mechanisms regulate matching based on


' specified punctuation characters. The matched sequence in String1


' is returned with any inclusive punctuation. Spaces, tabs and the


' defined punctuations are not counted when comparing match lengths.


' Any punctuation not specified in one of the two constants below


' are treated as part of the word (like the apostrophe in"I'll")


'


Option Explicit


'


' (Two consecutive double quotes inside a quoted string puts one


' double quote into the string value.)


'


' Punctuation2Space characters are word delimiters


Private Const Punctuation2Space ="(){}[]:;<>"""


'


' PunctuationDelete characters are word concatenators.


' Therefore"'.-" means"we're"="were" and"123.456.7890"="123-456-7890"


Private Const PunctuationDelete =",.?!"


'



Private Function LongestMatch(ByVal sentence As String, ByVal sentence2 _


 As String, Optional caseInsensitive As Boolean) As String


 Dim matchOnWords() As String


 Dim startAndItems() As Long


 Dim start, items As Long



 'Optional Booleans are False by default. If Case_Insensitive is True the


 'search will not be case sensitive. So the default search is case sensitive.


 LongestMatch = sentence


 If caseInsensitive Then


 sentence = LCase(sentence)


 sentence2 = LCase(sentence2)


 End If


 matchOnWords = getWords(sentence)



 startAndItems = getMatchStartAndItems(matchOnWords, getWords(sentence2))


 start = startAndItems(0)


 items = startAndItems(1)


 'Debug.Print start &"," & items


 If start = -1 Or items = 0 Then


 LongestMatch =""


 Else


 LongestMatch = getMatchedString(sentence, LongestMatch, matchOnWords, _


 start, items)


 End If


 'Debug.Print"'" & LongestMatch &"'"


End Function


Private Function getMatchedString(ByVal sentence As String, _


 ByVal original As String, ByRef matchOnWords() As String, _


 ByVal start As Long, ByVal items As Long) As String


 Dim allPartialWords() As String


 Dim begun As Boolean


 Dim w, i As Long



 ' word list based on every defined punctuation being seen as a word boundary,


 ' even words previously concatenated by the PunctuationDelete Const


 allPartialWords = getWords(sentence, True)


 begun = False


 i = 0


 For w = 0 To UBound(allPartialWords)


 ' make the beginning of the sentence be the beginning location of the


 ' first occurrence in the sentence where the current iterative word


 ' list element (partial word) is located removing preceeding spaces,


 ' tabs and punctuation charactrs defined in punctuation constants.


 sentence = Mid(sentence, InStr(sentence, allPartialWords(w)))


 If Not begun And i = start Then 'Begin


 begun = True


 ' delete any characters at the beginning of the original sentence


 ' that have already been removed from the sentence variable


 original = Mid(original, Len(original) - Len(sentence) + 1)


 End If


 ' remove the current partial word from the beginning of the sentence


 sentence = Mid(sentence, Len(allPartialWords(w)) + 1)


 ' remove the first occurence of this partial word from current


 ' match_on_word and any preceeding punctuation


 matchOnWords(i) = Mid(matchOnWords(i), InStr(matchOnWords(i), _


 allPartialWords(w)) + Len(allPartialWords(w)))


 If matchOnWords(i) ="" Then ' match_on_word is consumed


 i = i + 1 ' move on to the next match_on_word


 If begun Then


 items = items - 1 'consumed word, decrement matched items count


 If items = 0 Then ' consumed all matched words.


 ' original already starts at beginning of match.


 ' Sentence had all matched partial words removed, remove


 ' the remaining characters in sentence from return value


 getMatchedString = Mid(original, 1, _


 Len(original) - Len(sentence))


 Exit Function


 End If


 End If


 End If


 Next w


 getMatchedString =""


End Function


Private Function getMatchStartAndItems(ByRef words1() As String, _


 ByRef words2() As String) As Long()


 Dim startAndItems(0 To 1) As Long


 Dim maxCharacters, maxStart, maxItems As Long



 maxCharacters = 0


 maxStart = -1


 maxItems = 0


 Dim i1, i2, i, l As Long


 For i1 = 0 To UBound(words1)


 For i2 = 0 To UBound(words2)


 If words1(i1) = words2(i2) Then


 l = Len(words1(i1))


 i = 1


 Do While i1 + i <= UBound(words1)


 If i2 + i> UBound(words2) Then Exit Do


 If words1(i1 + i) <> words2(i2 + i) Then Exit Do


 l = l + Len(words1(i1 + i))


 i = i + 1


 Loop


 If l> maxCharacters Then


 maxCharacters = l


 maxStart = i1


 maxItems = i


 End If


 End If


 Next i2


 Next i1


 startAndItems(0) = maxStart


 startAndItems(1) = maxItems


 getMatchStartAndItems = startAndItems


End Function


Private Function getWords(ByVal sentence As String, _


 Optional nonDeletion As Boolean) As String()


 sentence = replaceChars(sentence, Punctuation2Space,"")


 sentence = replaceChars(sentence, PunctuationDelete, IIf(nonDeletion,"",""))


 sentence = Replace(sentence, vbTab,"")


 Do While InStr(sentence,"") <> 0


 sentence = Replace(sentence,"","")


 Loop


 sentence = Trim(sentence)


 getWords = Split(sentence)


End Function


Private Function replaceChars(ByVal source As String, ByVal chars As String, _


 ByVal replacement As String) As String


 Dim c As Long


 For c = 1 To Len(chars)


 source = Replace(source, Mid(chars, c, 1), replacement)


 Next c


 replaceChars = source


End Function





PAR  ext  文本  TEX  MAT  Extra  
相关文章