自己做的电话本

楼主研究研究	现在大家离不开电脑和电话的人越来越多了。但是人脑毕竟是人脑记不住很多东西。就想我对英文和数字很敏感所以写了这个电话本用EXCEL做电话本有几个好处，就是记录量大，而且查询快而准电话本.rar
2楼研究研究	电话本带有使用说明，我这里就不在啰唆了我要说的是几段代码 If Trim(Sheets("查询").Cells(6, 1).Value) = "" Then With Sheets("数据库") a = .Range("B65536").End(xlUp).Row Sheets("查询").Cells(6, 1) = Sheets("数据库").Cells(a, 1) + 1 End With End If If Trim(Sheets("查询").Cells(6, 2).Value) = "" Then MsgBox "没有姓名保存什么？！", vbOKOnly Exit Sub End If If Application.WorksheetFunction.CountA(Sheets("查询").Range("C6:K6")) = 0 Then MsgBox "没有号码保存什么？", vbOKOnly Exit Sub End If Dim Xulie As String Dim n As Long Dim Flag As Boolean '判断是否找到 n = 1 With Sheets("数据库") Xulie = Sheets("查询").Cells(6, 1) Do While .Cells(n, 1) <> "" If .Cells(n, 1) = Xulie Then Xulie = Sheets("查询").Cells(6, 2) Exit Do End If n = n + 1 Loop End With If Sheets("数据库").Cells(n, 2) = Xulie Then a = n Sheets("数据库").Range("A" & a & ":Q" & a) = Range("A6:Q6").Value Sheets("查询").Select ActiveWindow.FreezePanes = False Rows("6:6").Select Range("B6").Activate Selection.Delete Shift:=xlUp Range("F13").Select ActiveWindow.FreezePanes = True End If If Sheets("数据库").Cells(n, 2) <> Xulie Then 新增_Click 这里是先查询在库里有没有这个名字。如有他的ID是否相同，如相同则覆盖原数据、不相同或者没有输入的没有ID则新增一条记录、
3楼研究研究	查询的代码。因为是模糊查询所以有时会有很多的信息，所以我关闭了屏幕更新 Application.ScreenUpdating = False '不闪的代码 Cells(1, 8) = Cells(2, 1) Cells(2, 8) = Cells(3, 1) Dim k, c As Range, frows As String, l As Long If Len(Sheets("查询").Range("D4").Value) < 1 Then Exit Sub Application.ScreenUpdating = False '不闪的代码 k = Sheets("查询").Range("D4").Value Sheets("查询").Rows("6:65536").ClearContents l = 5 With Sheets("数据库").Range("b2:q" & Sheets("数据库").UsedRange.Rows.Count) Set c = .Find(k, LookIn:=xlValues, lookat:=xlPart) If Not c Is Nothing Then firstAddress = c.Address Do If InStr(frows, "\|" & c.Row & "\|") < 1 Then l = l + 1 Sheets("数据库").Rows(c.Row).Copy Sheets("查询").Cells(l, 1) frows = frows & "\|" & c.Row & "\|" End If Set c = .FindNext(c) Loop While Not c Is Nothing And firstAddress <> c.Address End If End With If Trim(Sheets("查询").Cells(6, 2).Value) = "" Then MsgBox "没有找到符合的信息!", vbOKOnly End If
4楼研究研究	删除和增加没有什么好说的了 Private Sub 删除_Click() Cells(1, 8) = Cells(2, 1) Cells(2, 8) = Cells(3, 1) Dim Xulie As String Dim n As Long Dim Flag As Boolean '判断是否找到 Flag = False n = 2 With Sheets("数据库") Xulie = Sheets("查询").Cells(6, 1) Do While Sheets("数据库").Cells(n, 1) <> "" If .Cells(n, 1) = Xulie Then .Rows(n).Delete Shift:=xlUp Sheets("查询").Select ActiveWindow.FreezePanes = False Rows("6:6").Select Range("B6").Activate Selection.Delete Shift:=xlUp Range("F13").Select ActiveWindow.FreezePanes = True Flag = True Exit Do End If n = n + 1 Loop End With If Flag = False Then MsgBox " 对不起没有找到！" Range("C4").Select End Sub Private Sub 新增_Click() With Sheets("数据库") a = .Range("B65536").End(xlUp).Row Sheets("查询").Cells(6, 1) = Sheets("数据库").Cells(a, 1) + 1 End With If Application.WorksheetFunction.CountA(Sheets("查询").Range("C6:K6")) = 0 Then MsgBox "没有一个号码?", vbOKOnly Exit Sub End If If Trim(Sheets("查询").Cells(6, 2).Value) = "" Then MsgBox "请输入姓名!", vbOKOnly Exit Sub End If With Sheets("数据库") a = a + 1 .Range("A" & a & ":Q" & a) = Range("A6:Q6").Value Sheets("查询").Select ActiveWindow.FreezePanes = False Rows("6:6").Select Range("B6").Activate Selection.Delete Shift:=xlUp Range("F13").Select ActiveWindow.FreezePanes = True End With End Sub 有不足之处希望高手帮我圆满。希望大家喜欢我的作品
5楼 lrlxxqxa	研究真强大支持原创
6楼 99253415	好东西我下载来好好学习
7楼悠悠雨	好东东呀，大家来一起学习
8楼 wqfzqgk
9楼 xinqing2019	很好，可以保存以后用，哈哈
10楼 jiawei00	henhao
11楼 lovewind1226	只能用膜拜来表达我的感情
12楼 hellosarah	这里牛人真是太多了啊~
13楼冰心8549	谢谢分享，学习学习
14楼 JOYARK1958	好东西我下载来好好学习