Question

我有代码可以工作并找到第一次出现但是可能会有多次出现相同的字符串。我想把所有这些出现并将它们存储在一个字符串数组中（我理解如何使用ReDim来调整数组的大小）。我已经尝试过查看其他一些编码示例，但似乎无法使其工作。

这是我找到第一次出现的工作代码

' Find the definition from the Excel document
With objWbk.Sheets("Sheet1")
    ' Find the range of the cells with data in Excel doc
    Set rngSearch = .Range(.Range("A1"), .Range("A" & .Rows.Count).End(-4162))

    ' Search in the found range for the
    Set rngFound = rngSearch.Find(What:=strAcronym, After:=.Range("A1"), LookAt:=1)

    ' if nothing is found count the number of acronyms without definitions
    If rngFound Is Nothing Then
        m = m + 1

        ' Set the cell variable in the new table as blank
        targetCellValue(0) = ""

    ' If a definition is found enter it into the cell variable
    Else
        i = 0
        targetCellValue(i) = .Cells(rngFound.Row, 2).Value
    End If
End With

你可以看到我已经介绍了数组，现在只需将i设置为0，因为我假设我需要实现一个循环才能找到它们。

**值得注意的是，所有字符串都按字母顺序排序

Answer 1

使用此代码：

ReDim Tmp(0 To 1000) As String
Dim i, e As Integer
Dim Max As Integer
Dim xx
Dim Str As String

Range("A1").Select
e = 0
Max = 0
Str = "a"
Set xx = Cells.Find(What:=Str, After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
    xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
    , SearchFormat:=False)

For i = 1 To 9999
    Cells.FindNext(After:=ActiveCell).Activate
    If (xx Is Nothing) Or (Max > ActiveCell.Row) Then Exit For
    Tmp(e) = ActiveCell.Offset(0, 1).Value
    e = e + 1
    Max = ActiveCell.Row
    Debug.Print e
Next
ReDim Preserve Tmp(e-1)

你找到了所有的出现。如果只想在列上更改两行：

'    Range("A1").Select
Columns("A:A").Select

'    Cells.FindNext(After:=ActiveCell).Activate
Selection.FindNext(After:=ActiveCell).Activate

仅在所选列/范围内查找。

Answer 2

Range有一个你可以使用的FindNext和FindPrevious方法，但它不会在最后停止 - 所以你必须检查它。

或者，您可以直接在单元格上进行迭代，

' Find the definition from the Excel document
With objWbk.Sheets("Sheet1")
    ' Find the range of the cells with data in Excel doc
    'Set rngSearch = .Range(.Range("A1"), .Range("A" & .Rows.Count).End(-4162))
    ' Search in the found range for the
    'Set rngFound = rngSearch.Find(What:=strAcronym, After:=.Range("A1"), LookAt:=1)
    ' if nothing is found count the number of acronyms without definitions    
    for z = 1 to .Rows.Count
        If Not (.Cells("A" &  z, 2).Value like strAcronym) Then
            m = m + 1        
            targetCellValue(0) = "" ' Set the cell variable in the new table as blank
        Else
            i = 0
            targetCellValue(i) = .Cells("A" & z, 2).Value ' If a definition is found enter it into the cell variable
        End If
    next i
End With

查找列中的所有字符串出现并从相邻列复制数据

2 个答案: