派出所的一個朋友在調(diào)查一起案件的時候，遇到了一個如題的問題，請我?guī)兔ΑＳ捎谝Ｃ芩荒芴峁┰紨?shù)據(jù)，只是給我談了一下要求。目前他們通過一個嫌疑犯的通話記錄，從通話記錄中又列入了n個新嫌疑犯，而且也得到每個嫌疑犯的通話記錄?，F(xiàn)在就要將這些通話記錄進行統(tǒng)計，即同一個電話號碼，每個嫌疑犯打了多少次，有多少個嫌疑犯同時打過同一個號碼。

　　根據(jù)上述總結(jié)，Excel表如下：

　　圖一：原始數(shù)據(jù)表電腦教程

　　圖二：統(tǒng)計結(jié)果表

　　上圖說明：

　　圖一：用戶一、用戶二、用戶三、用戶四正面的數(shù)字為模擬的電話號碼;方向是指主叫還是被叫，沒有什么意義。

　　圖二：用戶正面的數(shù)字是該電話所使用的次數(shù)，如果一個電話只被某一用戶打過，這樣就不統(tǒng)計，換句話說就是統(tǒng)計結(jié)果表中的電話號碼至少被兩個以上的用戶打過。

　　解決的思路：

　　⒈ 此統(tǒng)計無法使用函數(shù)、數(shù)據(jù)透視表等普通的方法來解決。我采用了VBA編程來實現(xiàn)的統(tǒng)計。

　?、?首先將所有用戶的電話(不重復，重復的只取一次)，提取出來存放到統(tǒng)計結(jié)果表中。這樣結(jié)果表中的電話是唯一的。

　?、?通過結(jié)果表的電話號碼為基礎，統(tǒng)計每個用戶使用該號碼的次數(shù)并將統(tǒng)計的結(jié)果存放到結(jié)果表該用戶下。

　?、?刪除同一個電話號碼被兩個以下用戶使用的行。

　　解決的方法：

　　⒈ 因為用戶的數(shù)量是未知的，但從第2列開始是已經(jīng)的，這樣我們就可以通過循環(huán)來進行統(tǒng)計。循環(huán)的條件通過第1行從第2列開始，單元格不空。

　?、?每個用戶的電話號碼循環(huán)與⒈類似

　　具體的程序源代碼如下：

　　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 "沒有用戶，無法統(tǒng)計!", 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 "統(tǒng)計完畢!", vbOKOnly + vbInformation, "系統(tǒng)提示"

　　Sheets(2).Select

　　End Sub