vba学习系列(9)--按需求计数单位格数目

系列文章目次

---

前言

一、按需求计数单位格数目

1.需求

   一个表中有多个范例的单位格内容，好比：笔墨、数字、特殊字符、字母+数字……
我们要计数字母+数字的单位格数目
同时提取字母+数字单位格的数字部分，判断数字部分是否雷同，然后计数差别的单位格数目
  二、使用步调

1.vba源码

   代码如下（示例）：

1. Sub CountSpecificFormatStrings()
2.     Dim rng As Range
3.     Dim cell As Range
4.     Dim count, countkey As Integer
5.     Dim regex, regex1 As Object
6.     Dim cellAddress As String
7.     Dim numbers As String
8.     Dim matches As Object
9.     Dim match As Variant
10.     Dim cellNumber As String
11.     Dim cellValue As String
12.     Dim myCollection As Collection
13.     Set myCollection = New Collection
14.     Dim value As Variant
15.     Dim lastValue As Variant
16.     Dim uniqueCount As Integer
17.     Dim ws As Worksheet
18.     Set ws = ActiveSheet
19.     Dim cellValueCollection As Collection
20.     Dim i, j, k As Integer
21.     Dim valueToAdd As String
22.     Dim key As Variant
23.     Dim dict As Object
24.     Dim myArray As Variant
25.     Dim item, ele As Variant
26.     Dim elements As Variant
27.     Dim uniquekeys As New Collection
29.     uniqueCount = 0
30.     lastValue = ""
31.     Set cellCollection = New Collection
32.     Set dict = CreateObject("Scripting.Dictionary")
33.    
34.     ' 设置要检查的范围
35.     Set rng = ws.Range("A3:DR200") ' 假设我们在Sheet1的A1:A10范围内查找
36.     count = 0
37.    
38.     ' 创建正则表达式对象
39.     Set regex = CreateObject("VBScript.RegExp")
40.    
41.     ' 设置正则表达式模式：一个字母后面跟随任意数量的数字
42.     ' 这里的模式是 [A-Za-z][0-9]+，其中 [A-Za-z] 匹配任意一个字母，[0-9]+ 匹配一个或多个数字
43.     With regex
44.         .Global = True
45.         .IgnoreCase = True
46.         .pattern = "[A-Za-z][0-9]+"
47.     End With
48.    
49.         ' 创建正则表达式对象
50.     Set regex1 = CreateObject("VBScript.RegExp")
51.    
52.     ' 设置正则表达式模式：一个字母后面跟随任意数量的数字
53.     ' 这里的模式是 [A-Za-z][0-9]+，其中 [A-Za-z] 匹配任意一个字母，[0-9]+ 匹配一个或多个数字
54.     With regex1
55.         .Global = True
56.         .IgnoreCase = True
57.         .pattern = "\d+"
58.     End With
60.     ' 遍历单元格
61.     For Each cell In rng
62.         If regex.Test(cell.value) Then ' 如果单元格匹配正则表达式
63.             count = count + 1 ' 增加计数
64.    
65.             Debug.Print "行：" & cell.Row & ",列:" & cell.Column & ",值:" & cell.value
66.             
67.             'Set matches = regex1.Execute(cell.Value)
68.             'For Each match In matches
69.                 'outputString = outputString & match.Value
70.                 'Debug.Print outputString
71.             'Next match
72.             'Debug.Print cell.Row & cell.Column
73.             'Debug.Print Cells(cell.Row, cell.Column).Value
74.             Set matches = regex1.Execute(Cells(cell.Row, cell.Column).value)
75.             For Each match In matches
76.                 myCollection.Add match
77.             Next match
78.             
79.         End If
80.     Next cell
81.    
82.    
83.     For Each item In myCollection
84.         'Debug.Print item
85.     Next
86.    
87.     countkey = myCollection.count
88.    
89.     For i = myCollection.count To 1 Step -1
90.         For j = 1 To i - 1
91.             If myCollection(i) = myCollection(j) Then
92.                 myCollection.Remove (i)
93.                 countkey = countkey - 1
94.                 Exit For
95.             End If
96.         Next j
97.     Next i
98.    
99.     For Each ele In myCollection
100.         Debug.Print ele
101.     Next ele
103.     ws.Cells(2, 69).value = countkey
105.     ' 显示计数结果
106.     MsgBox "有 " & countkey & " 个单元格符合指定格式。"
107. End Sub

复制代码

2.整理后

   代码如下（示例）：

1. Sub CountSpecificFormatStrings()
2.     Dim rng As Range
3.     Dim cell As Range
4.     Dim count, countkey As Integer
5.     Dim regex As Object
6.     Dim matches As Object
7.     Dim match As Variant
8.     Dim myCollection As Collection
9.     Set myCollection = New Collection
10.     Dim ws As Worksheet
11.     Set ws = ActiveSheet
12.     Dim i, j As Integer
13.     Dim key As Variant
14.     Dim item, ele As Variant
15.    
16.     ' 设置要检查的范围
17.     Set rng = ws.Range("A3:DR200") ' 假设我们在Sheet1的A1:A10范围内查找
18.     count = 0
19.    
20.     ' 创建正则表达式对象
21.     Set regex = CreateObject("VBScript.RegExp")
22.    
23.     ' 设置正则表达式模式：一个字母后面跟随任意数量的数字
24.     ' 这里的模式是 [A-Za-z][0-9]+，其中 [A-Za-z] 匹配任意一个字母，[0-9]+ 匹配一个或多个数字
25.     With regex
26.         .Global = True
27.         .IgnoreCase = True
28.         .pattern = "[A-Za-z][0-9]+"
29.     End With
30.    
31.         ' 创建正则表达式对象
32.     Set regex1 = CreateObject("VBScript.RegExp")
33.    
34.     ' 设置正则表达式模式：一个字母后面跟随任意数量的数字
35.     ' 这里的模式是 [A-Za-z][0-9]+，其中 [A-Za-z] 匹配任意一个字母，[0-9]+ 匹配一个或多个数字
36.     With regex1
37.         .Global = True
38.         .IgnoreCase = True
39.         .pattern = "\d+"
40.     End With
41.    
42.     ' 遍历单元格
43.     For Each cell In rng
44.         If regex.Test(cell.value) Then ' 如果单元格匹配正则表达式
45.             count = count + 1 ' 增加计数
46.             Debug.Print "行：" & cell.Row & ",列:" & cell.Column & ",值:" & cell.value
47.             'Set matches = regex1.Execute(cell.Value)
48.             'For Each match In matches
49.                 'outputString = outputString & match.Value
50.                 'Debug.Print outputString
51.             'Next match
52.             'Debug.Print cell.Row & cell.Column
53.             'Debug.Print Cells(cell.Row, cell.Column).Value
54.             Set matches = regex1.Execute(Cells(cell.Row, cell.Column).value)
55.             For Each match In matches
56.                 myCollection.Add match
57.             Next match
58.         End If
59.     Next cell
60.         
61.     For Each item In myCollection
62.         'Debug.Print item
63.     Next
64.     countkey = myCollection.count
65.     For i = myCollection.count To 1 Step -1
66.         For j = 1 To i - 1
67.             If myCollection(i) = myCollection(j) Then
68.                 myCollection.Remove (i)
69.                 countkey = countkey - 1
70.                 Exit For
71.             End If
72.         Next j
73.     Next i
74.     For Each ele In myCollection
75.         Debug.Print ele
76.     Next ele
77.     ws.Cells(2, 69).value = countkey
78.    
79.     ' 显示计数结果
80.     MsgBox "有 " & countkey & " 个单元格符合指定格式。"
81. End Sub

复制代码

---

总结

分享：
读过的书是不是有许多不记得了，但是它不绝都是匿伏的，它在我们的出言有尺上，嬉闹有度上，服务有余上，语言有德上