文章程序,如有dx加注释,可能我就能理解了 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
[此贴子已经被作者于2006-12-9 11:47:01编辑过] |