Question

我有一个输入文本字符串，范围从A1到AV1，每个字母在一个单元格中。字符串是

从A1到AV1如下

  | A B C D E F G H I J K L M N O P Q R S T U V W X Y Z AA AB AC AD AE AF AG AH AI AJ AK AL AM AN AO AP AQ AR AS AT AU AV
--------------------------------------------------------------------------------------------------------------------------
1 | M i c r o s o f t E x c e l i s a s p r e a d s h e e  t  d  e  v  e  l  o  p  e  d  b  y  M  i  c  r  o  s  o  f  t

我希望能够搜索子字符串，如果找到，请选择存在子字符串的范围。

如果输入文本字符串在同一行中，我下面的当前代码将起作用，但是我受困于如何操作如果字符串在不同的行中，例如，如果相同的输入文本字符串在范围A1：O4中，而我想搜索从N2开始到G3结束的“已开发”子字符串。

Sub SelectRangeofSubString()
Rng = Range("A1:AV1")

a = Range("A1").CurrentRegion
aa = WorksheetFunction.Transpose(WorksheetFunction.Transpose(a))
str1 = Join(aa, "")

StringToSearch = "developed"
StringLength = Len(StringToSearch)
Pos = InStr(str1, StringToSearch)

Range(Cells(1, Pos), Cells(1, Pos + StringLength - 1)).Select

End Sub

从A1到O4就像这样

  | A   B   C   D   E   F   G   H   I   J   K   L   M   N   O
---------------------------------------------------------------
1 | M   i   c   r   o   s   o   f   t   E   x   c   e   l   i
2 | s   a   s   p   r   e   a   d   s   h   e   e   t   d   e
3 | v   e   l   o   p   e   d   b   y   M   i   c   r   o   s
4 | o   f   t

感谢您的帮助

更新

都谢谢。它在两种解决方案中均有效。我的最后一个问题，当每个单元格包含2个字母时，我尝试了相同的方法，在这种情况下，您能帮我选择范围吗？

例如stringToSearch =“ developed”并且数据来自范围A1：H3

    A   B   C   D   E   F   G   H
----------------------------------
1 | Mi  cr  os  of  tE  xc  el  is
2 | as  pr  ea  ds  he  et  de  ve
3 | lo  pe  db  yM  ic  ro  so  ft

Answer 1

我根据必须查看Range（“ A1：O4”）的信息修改了您的代码

Sub SelectRangeofSubString()
Dim rng As Range
Dim a, str1, stringtosearch, stringlength, pos
Dim i As Long, j As Long
    Set rng = Range("A1:O4")

    a = rng ' Range("A1").CurrentRegion
    'aa = WorksheetFunction.Transpose(WorksheetFunction.Transpose(a))
    For i = LBound(a, 1) To UBound(a, 1)
        For j = LBound(a, 2) To UBound(a, 2)
            str1 = str1 & a(i, j)
        Next
    Next

    stringtosearch = "developed"
    stringlength = Len(stringtosearch)
    pos = InStr(str1, stringtosearch)

    Dim resRg As Range
    Set resRg = rng.Item(pos)
    For i = pos + 1 To pos + Len(stringtosearch) - 1
        Set resRg = Union(resRg, rng.Item(i))
    Next i
    resRg.Select

End Sub

Answer 2

我把这个问题变成了一个子例程，它将使用SearchRange和SearchString作为参数。

子例程将选择找到第一个匹配项的单元格。如果您想返回apk add py3-setuptools对象，应该很容易进行切换。

Range

修改

对此进行了更新，以在一个单元格中处理2个或更多字符。这最多可以使用Private Sub FindWord(SearchRange As Range, SearchString As String) Dim LetterArray As Variant Dim RangeArray As Variant Dim ws As Worksheet Dim Letter As Range Dim i As Long Dim SelectedRng As Range Dim StringPosition As Long Dim LastSearchIndex As Long ReDim LetterArray(1 To SearchRange.Cells.Count) ReDim RangeArray(1 To SearchRange.Cells.Count) Set ws = SearchRange.Parent For Each Letter In SearchRange i = i + 1 LetterArray(i) = Letter.Value2 RangeArray(i) = Letter.Address Next StringPosition = InStr(1, Join(LetterArray, vbNullString), SearchString) If StringPosition <= 0 Then Exit Sub LastSearchIndex = Len(SearchString) + StringPosition - 1 For i = StringPosition To LastSearchIndex If SelectedRng Is Nothing Then Set SelectedRng = ws.Range(RangeArray(i)) Else Set SelectedRng = Union(SelectedRng, ws.Range(RangeArray(i))) End If Next SelectedRng.Select End Sub Sub SelectIt() Dim rng As Range Set rng = ThisWorkbook.Sheets("Sheet1").Range("A1:D4") FindWord rng, "developed" End Sub个字符，但是我只是对此进行了简要测试。希望对您有所帮助。我将保留另一种方法作为后代。

我应该提到此修订方法确实假设所有单元格中的字符数均相同。如果那不是真的，那可能就行不通了。

在Excel范围VBA中查找子字符串

2 个答案: