VBA查找选定区域内包含某字符串的个数

yslvictor

VBA查找选定区域内包含某字符串的个数.rar (10.89 KB, 下载次数: 9)

2024-8-18 07:51 上传

点击文件名下载附件

excel里的5 6错的
本人对vba代码了解不多，望老师写段代码，解当下燃眉之急，谢谢。

yslvictor

查错了，6出现的个数是6次

wanao2008

希望能够帮助到你：

1. Sub byWanao()
   
2.     Dim str$, i&, j&
   
3.     For i = 4 To Cells(Rows.Count, "B").End(xlUp).Row
   
4.         str = str & Cells(i, 2)
   
5.     Next
   
6.     For j = 0 To 9
   
7.         i = Len(str)
   
8.         str = Replace(str, j, "")
   
9.         Cells(5, j + 3) = i - Len(str)
   
10.     Next
    
11. End Sub

复制代码

quqiyuan

参与一下，精工参考。。。。

quqiyuan

代码如下。。。
Sub 查找()
    arr = Sheet1.Range([b4], Cells(Rows.Count, 2).End(3))
    Set d = CreateObject("scripting.dictionary")
    brr = Sheet1.[c3:l3]
    For i = 1 To UBound(brr, 2)
        d(CStr(brr(1, i))) = 0
    Next
    For i = 1 To UBound(arr)
        For j = 1 To Len(arr(i, 1))
            If d.exists(Mid(arr(i, 1), j, 1)) Then d(Mid(arr(i, 1), j, 1)) = d(Mid(arr(i, 1), j, 1)) + 1
        Next
    Next
    Sheet1.[c4:l4].ClearContents
    Sheet1.[c4:l4].Resize(, UBound(brr, 2)) = d.items
    Set d = Nothing
    Beep
End Sub

gwjkkkkk

Option Explicit
Sub TEST6()
    Dim ar, i&, j&, r&, dic As Object, strKey$
   
    Application.ScreenUpdating = False
    Set dic = CreateObject("Scripting.Dictionary")
   
    r = Cells(Rows.Count, "B").End(xlUp).Row
    ar = Range("B3:B" & r).Value
    For i = 2 To UBound(ar)
        For j = 1 To Len(ar(i, 1))
            strKey = Mid(ar(i, 1), j, 1)
            dic(strKey) = dic(strKey) + 1
        Next j
    Next i
    ReDim ar(9)
    For j = 0 To 9
        ar(j) = dic(CStr(j)) * 1
    Next j
   
    [C4].Resize(, 10) = ar
    Set dic = Nothing
    Application.ScreenUpdating = True
    Beep
End Sub

gwjkkkkk

...........

yslvictor

谢谢各位老师，都写的非常好，学习了。

songshihai

5和6的结果为什么会不一样???谁错了?