根據(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)計。
⒉ 首先將所有用戶的電話(不重復(fù),重復(fù)的只取一次),提取出來存放到統(tǒng)計結(jié)果表中。這樣結(jié)果表中的電話是唯一的。
⒊ 通過結(jié)果表的電話號碼為基礎(chǔ),統(tǒng)計每個用戶使用該號碼的次數(shù)并將統(tǒng)計的結(jié)果存放到結(jié)果表該用戶下。
⒋ 刪除同一個電話號碼被兩個以下用戶使用的行。
解決的方法:
⒈ 因為用戶的數(shù)量是未知的,但從第2列開始是已經(jīng)的,這樣我們就可以通過循環(huán)來進(jì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 |