Excel统计某电话号码有多少人打过
2006-10-21 21:29:22 来源:WEB开发网核心提示: ⒉ 每个用户的电话号码循环与⒈类似具体的程序源代码如下:Private Sub CommandButton1_Click()Sheets(2).Rows(2 & ":" & 65536) = ""Sheets(2).Columns("B:I
⒉ 每个用户的电话号码循环与⒈类似
具体的程序源代码如下:
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
更多精彩
赞助商链接