如何列出列表中变量的所有位置?

时间:2010-11-15 09:26:54

标签: excel excel-vba vba

我有一大堆文字字符串。我知道在这个列表中有些字符串不止一次出现。字符串出现的频率在下一栏中。

现在,假设文本字符串“hello”出现了17次。我如何在列表中获得此文本的所有位置?

感谢任何帮助。

2 个答案:

答案 0 :(得分:1)

彼得,

查看this post of Stack Overflow

我也试图调整他们的示例代码以匹配你的情况,我很抱歉,虽然这可能无法编译,我现在无法测试它,我的VBA有点生疏,但你明白了。< / p>

Function CheckValues1(byval columnToCheck as Integer, byval stringToFind as String) as Integer()
    dim rwIndex As Integer
    dim index as Integer
    dim occurrences() As Integer
    index = 0

    For rwIndex = 0 to Cells(Rows.Count, columnToCheck).End(xlUp).Row

       ReDim Preserve occurrences(0 to index)

       If Cells(rwIndex, columnToCheck).Value = stringToFind Then
           occurrences(index) = rwIndex
           index = index + 1
       End If

    Next rwIndex

    dim output as String
    output = output & (Len(occurrences)-1) & " occurrences found." & vbcrlf & vbcrlf
    For index = 0 to LBound(occurrences)

        output = output & "Line: " & index & vbcrlf

    Next index
    MsgBox output

End Sub

这个函数应该返回一个数组,其中包含你可以处理的所有出现的数据。您只需要传入您正在寻找的字符串和要在其中搜索的列号。

我希望这有帮助!

答案 1 :(得分:1)

假设您的所有字符串都在一列中,您可以添加第二列及其位置(行号),并在显示计数的字符串上执行数据透视表。

为了获得您感兴趣的字符串的位置,您可以使用数据透视表的向下钻取功能(双击字符串旁边的计数),这将创建一个包含所有详细记录的新工作表 - 并显示位置

希望有所帮助

好锁

交换意见后编辑:

我会寻求一种解决方案,只扫描您的数据一次而不是递归,将值复制到第二张表:

for each string in sourcetable
   if found in targettable
      increase targettable.counter by 1 (remark: in column_2)
   else
      put sourcetable.string at end of targettable
      put "1" in targettable.counter (remark: occurence = 1 in column_2)
   endif
   put sourcetable.index into targettable.column(counter+2)
next

到目前为止,metacode ....你需要更多帮助才能在VBA中实际编写代码吗?

编辑2

好的......做了一个快速的&amp;肮脏的......

Sub CountString()
Dim S As Range, T As Range, Idx As Long, Jdx As Long

    Set S = Worksheets("Sheet1").[A2] ' first row is header
    Set T = Worksheets("Sheet2").[A2] ' first row is header
    Idx = 1

    Do While S(Idx, 1) <> ""
        Jdx = FindInRange(T, S(Idx, 1))
        If T(Jdx, 1) = "" Then
            T(Jdx, 1) = S(Idx, 1)
            T(Jdx, 2) = 1
            T(Jdx, 3) = Idx
        Else
            T(Jdx, 2) = T(Jdx, 2) + 1
            T(Jdx, T(Jdx, 2) + 2) = Idx
        End If
        Idx = Idx + 1
    Loop
End Sub

Function FindInRange(R As Range, A As String) As Long
Dim Idx As Long

    Idx = 1
    Do While R(Idx, 1) <> ""
        If R(Idx, 1) = A Then
            Exit Do
        End If
        Idx = Idx + 1
    Loop
    FindInRange = Idx
End Function

用“Lorem ipsum”中的500个单词测试 - 低于1秒,sheet_2中的输出看起来像

String     Count   Position ...                                                        
Lorem        1        1                                                        
ipsum        6        2        45        65       232       323       462                
dolor        5        3        42       214       321       335                        
sit          6        4        79       148       249       295       415                
amet         6        5        80       149       250       296       416                
consectetur  8        6       117       288       298       396       457       473        486
adipiscing   3        7       180       402                                        

希望有所帮助