Excel统计某电话号码有多少人打过
2008-02-23 05:44:14来源:互联网 阅读 ()
派出所的一个朋友在调查一起案件的时候,遇到了一个如题的问题,请我帮忙。由于要保密他不能提供原始数据,只是给我谈了一下要求。目前他们通过一个嫌疑犯的通话记录,从通话记录中又列入了n个新嫌疑犯,而且也得到每个嫌疑犯的通话记录。现在就要将这些通话记录进行统计,即同一个电话号码,每个嫌疑犯打了多少次,有多少个嫌疑犯同时打过同一个号码。
根据上述总结,Excel表如下:
图一:原始数据表
图二:统计结果表
上图说明:
图一:用户一、用户二、用户三、用户四正面的数字为模拟的电话号码;方向是指主叫还是被叫,没有什么意义。
图二:用户正面的数字是该电话所使用的次数,如果一个电话只被某一用户打过,这样就不统计,换句话说就是统计结果表中的电话号码至少被两个以上的用户打过。
解决的思路:
⒈ 此统计无法使用函数、数据透视表等普通的方法来解决。我采用了VBA编程来实现的统计。
⒉ 首先将所有用户的电话(不重复,重复的只取一次),提取出来存放到统计结果表中。这样结果表中的电话是唯一的。
⒊ 通过结果表的电话号码为基础,统计每个用户使用该号码的次数并将统计的结果存放到结果表该用户下。
⒋ 删除同一个电话号码被两个以下用户使用的行。
解决的方法:
⒈ 因为用户的数量是未知的,但从第2列开始是已经的,这样我们就可以通过循环来进行统计。循环的条件通过第1行从第2列开始,单元格不空。
⒉ 每个用户的电话号码循环与⒈类似
具体的程序源代码如下:
Private Sub CommandButton1_Click() Sheets(2).Rows(2 & ":" & 65536) = "" Sheets(2).Columns("B:IV") = "" Dim Ls, i, j, Isa, k, yhs Isa = False i = 2 If Sheets(1).Cells(1, 2) = "" Then MsgBox "没有用户,无法统计!", vbOKOnly vbCritical, "错误提示" Exit Sub Else Do While True If Sheets(1).Cells(1, i) <> "" Then Sheets(2).Cells(1, i) = Sheets(1).Cells(1, i) i = i 1 Else Exit Do End If Loop yhs = i - 1 End If Ls = 2 Do While Sheets(1).Cells(1, Ls) <> "" i = 2 Do While Sheets(1).Cells(i, Ls) <> "" If Sheets(2).Cells(2, 1) = "" Then Sheets(2).Cells(2, 1) = Sheets(1).Cells(i, Ls) Else j = 2: Isa = False Do While Sheets(2).Cells(j, 1) <> "" If Sheets(2).Cells(j, 1) = Sheets(1).Cells(i, Ls) Then Isa = True: Exit Do j = j 1 Loop If Not Isa Then Sheets(2).Cells(j, 1) = Sheets(1).Cells(i, Ls) End If i = i 1 Loop Ls = Ls 1 Loop Ls = 2 Do While Sheets(2).Cells(1, Ls) <> "" i = 2 Do While Sheets(2).Cells(i, 1) <> "" j = 2: k = 0 Do While Sheets(1).Cells(j, Ls) <> "" If Sheets(2).Cells(i, 1) = Sheets(1).Cells(j, Ls) Then k = k 1 j = j 1 Loop If k <> 0 Then Sheets(2).Cells(i, Ls) = k i = i 1 Loop Ls = Ls 1 Loop '=========================================== ' 删除非同一电话多个用户使用的行 '=========================================== i = 2 Do While Sheets(2).Cells(i, 1) <> "" j = 2: k = 0 Do While j <= yhs If Sheets(2).Cells(i, j) <> "" Then k = k 1 j = j 1 Loop If CInt(k) < 2 Then Sheets(2).Rows(i).Delete Shift:=xlUp '删除i行 Else i = i 1 End If Loop '=========================================== MsgBox "统计完毕!", vbOKOnly vbInformation, "系统提示" Sheets(2).Select End Sub |
标签:
版权申明:本站文章部分自网络,如有侵权,请联系:west999com@outlook.com
特别注意:本站所有转载文章言论不代表本站观点,本站所提供的摄影照片,插画,设计作品,如需使用,请与原作者联系,版权归原作者所有
IDC资讯: 主机资讯 注册资讯 托管资讯 vps资讯 网站建设
网站运营: 建站经验 策划盈利 搜索优化 网站推广 免费资源
网络编程: Asp.Net编程 Asp编程 Php编程 Xml编程 Access Mssql Mysql 其它
服务器技术: Web服务器 Ftp服务器 Mail服务器 Dns服务器 安全防护
软件技巧: 其它软件 Word Excel Powerpoint Ghost Vista QQ空间 QQ FlashGet 迅雷
网页制作: FrontPages Dreamweaver Javascript css photoshop fireworks Flash