Excel精英培训网

 找回密码
 注册
数据透视表40+个常用小技巧,让你一次学会!
楼主: qinhuan66

[已解决]高难度的求助:获取数据库某条信息进行资料修改;后如何替换原先的本条记录数据。谢谢

[复制链接]
发表于 2013-6-7 14:18 | 显示全部楼层
点获取数据的时候,应该得把刷屏打开,这样就能看到实时的数据情况,好做选择是否要下一条。
excel精英培训的微信平台,每天都会发送excel学习教程和资料。扫一扫明天就可以收到新教程
回复

使用道具 举报

 楼主| 发表于 2013-6-7 14:28 | 显示全部楼层
hwc2ycy 发表于 2013-6-7 14:15

谢谢您了都是。真的可以了,不过有一点还是修改不了,那就是下图,这个可以有点难呀
2013-06-07_142638.gif
回复

使用道具 举报

发表于 2013-6-7 14:31 | 显示全部楼层
回复

使用道具 举报

发表于 2013-6-7 14:38 | 显示全部楼层    本楼为最佳答案   
原来引用的是SHEET1,现在是SHEET3了,
  1. Sub 修改数据库()
  2.     Dim AccessFile As String, Database As String, sql As String
  3.     Dim StrConn$, strSql$
  4.     Dim lLastRow&
  5.     Dim arr, i&, j As Byte

  6.     Dim AdoxCat As Object
  7.     Dim AdoCmd As Object
  8.     Dim AdoConn As Object
  9.     Dim AdoRst As Object

  10.     On Error GoTo Errcheck
  11.     AccessFile = ThisWorkbook.Path & "\gkzp.mdb"
  12.     Database = "gkzp"
  13.     If Dir(AccessFile) = "" Then

  14.         '检测文件是否存在,不存在则创建数据库
  15.         Set AdoxCat = CreateObject("adox.catalog")
  16.         AdoxCat.Create "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & AccessFile & ";Jet OLEDB:Database Password=695360052;"
  17.         Set AdoConn = AdoxCat.ActiveConnection
  18.         Set AdoCmd = CreateObject("ADODB.Command")
  19.         Set AdoCmd.ActiveConnection = AdoConn
  20.         AdoCmd.CommandText = "CREATE TABLE " & Database & _
  21.                              " (报名序号 text(3),报名时间 datetime ,报考类别 text(30),操作员 text(6),姓名 text(8),性别 text(2),出生日期 datetime ,籍贯 text(30),民族 text(10)," & _
  22.                              "政治面貌 text(20),健康状况 text(20),参加工作时间 datetime ,最高学历毕业时间 datetime ,移动电话 text(12),固定电话 text(11),身份证号 text(18),电子邮箱 text(20)," & _
  23.                              "现工作单位及职务(或家庭住址) text(50),报考职位 text(50),全日制教育 text(50),全日制教育毕业院校及专业 text(50),在职教育 text(50),在职教育毕业院校及专业 text(50),学习工作简历 text(50),提供材料 text(120),资格审查情况 text(6))"

  24.         AdoCmd.Execute
  25.         Set AdoCmd = Nothing
  26.         Set AdoxCat = Nothing
  27.         Set AdoConn = Nothing

  28.     End If
  29.     If Len([B3]) = 0 Or Len([F3]) = 0 Or Len([J3]) = 0 Or Len([B4]) = 0 Or Len([F4]) = 0 Or Len([J4]) = 0 Or Len([B5]) = 0 Or Len([F5]) = 0 Or Len([J5]) = 0 Or Len([C6]) = 0 Or Len([J6]) = 0 Or Len([C7]) = 0 Or Len([J7]) = 0 Or Len([E8]) = 0 Or Len([E9]) = 0 Or Len([D10]) = 0 Or Len([I10]) = 0 Or Len([D11]) = 0 Or Len([I11]) = 0 Or Len([B12]) = 0 Then
  30.         MsgBox "对不起!黄色区域数据输入不完整,请先填好数据再进行提交。"
  31.         Exit Sub
  32.     End If



  33.     StrConn = "Provider= Microsoft.Jet.OLEDB.4.0;" & _
  34.               "Data Source='" & AccessFile & "';jet oledb:Database Password=695360052"

  35.     Set AdoConn = CreateObject("ADODB.Connection")
  36.     With AdoConn
  37.         .CursorLocation = 3
  38.         .Mode = 3
  39.         .CommandTimeout = 5
  40.         .connectionTimeout = 5
  41.         .Open StrConn
  42.     End With


  43.     strSql = "select * from " & Database & " where 报名时间=#" & [L4] & "# " & " and 性别 like '" & [F3] & "' and 身份证号='" & [C7] & "'"



  44.     Dim strTGCL$    '提供材料
  45.     Dim strZGSCQK$  '资格审查情况
  46.     Dim item1

  47.     With Sheet3
  48.         For Each item1 In .OLEObjects   '控件遍历
  49.             With item1
  50.                 If .Name Like "CheckBox*" Then  '过滤非CHECKBOX
  51.                     Select Case True
  52.                         Case .Object.Value And .TopLeftCell.Row = 17    '17行的数据
  53.                             strTGCL = strTGCL & .Object.Caption & ","
  54.                         Case .Object.Value And .TopLeftCell.Row = 22    '22行的数据
  55.                             strZGSCQK = strZGSCQK & item1.Object.Caption & ","
  56.                     End Select

  57.                 End If
  58.             End With
  59.         Next
  60.     End With

  61.     If Len(strTGCL) Then
  62.         strTGCL = Left(strTGCL, Len(strTGCL) - 1)  '过滤最后的","
  63.     Else
  64.         strTGCL = "无"
  65.     End If
  66.     [b17] = strTGCL


  67.     If Len(strZGSCQK) Then
  68.         strZGSCQK = Left(strZGSCQK, Len(strZGSCQK) - 1)  '过滤最后的","
  69.     Else
  70.         strZGSCQK = "无"
  71.     End If
  72.     [b22] = strZGSCQK



  73.    
  74.     Set AdoRst = CreateObject("adodb.recordset")
  75.     AdoRst.Open strSql, AdoConn, 0, 3
  76.     If AdoRst.RecordCount = 0 Then        '
  77.         strSql = " insert into " & Database & " values('" & [L3] & "',#" & [L4] & "#,'" & [L5] & "','" & [L6] & "','" & [B3] & "','" & [F3] & "',#" & [J3] & "#,'" & [B4] & "','" & [F4] & "','" & _
  78.                  [J4] & "','" & [B5] & "',#" & [F5] & "#,'" & [J5] & "','" & [C6] & "','" & [J6] & "','" & [C7] & "','" & [J7] & "','" & _
  79.                  [E8] & "','" & [E9] & "','" & [D10] & "','" & [I10] & "','" & [D11] & "','" & [I11] & "','" & [B12] & "','" & strTGCL & "','" & strZGSCQK & "')"
  80.         AdoConn.Execute strSql
  81.         MsgBox "呵呵!本次数据已成功添加的数据库"
  82.         [B3:C3,F3:G3,J3,L3,B4:C4,F4:G4,J4,L4,B5:C5,F5:G5,J5,L5,C6:G6,J6,L6,C7:G7,J7:L7,E8:L8,E9:L9,D10:F10,I10:L10,D11:F11,I11:L11,B12:L16] = ""
  83.         [L3] = [L3] + 1

  84.         '清除单选框
  85.         With Sheet1
  86.             For Each item1 In .OLEObjects   '控件遍历
  87.                 With item1
  88.                     Select Case TypeName(.Object)
  89.                         Case "CheckBox"
  90.                             .Object.Value = False
  91.                     End Select
  92.                 End With
  93.             Next
  94.         End With

  95.     Else
  96.         strSql = "upate " & Database & " set "
  97.         Dim m As Integer
  98.         Dim rg As Range, rg1 As Range
  99.         Set rg = Range("L3,L4,L5,L6,B3,F3,J3,B4,F4,J4,B5,F5,J5,C6,J6,C7,J7,E8,E9,D10,I10,D11,I11,B12,b17,b22")
  100.         With AdoRst
  101.             For Each rg1 In rg
  102.                 Debug.Print .Fields(m).Value
  103.                 .Fields(m).Value = rg1.Value
  104.                 Debug.Print .Fields(m).Value
  105.                 m = m + 1
  106.                 'Stop
  107.             Next
  108.             .Update
  109.         MsgBox "更新完成"
  110.         End With
  111.         [b17] = ""
  112.         [b22] = ""
  113.         
  114.     End If

  115.     AdoConn.Close
  116.     Set AdoConn = Nothing
  117.     Exit Sub

  118. Errcheck:

  119.     MsgBox Err.Number & vbNewLine & _
  120.            Err.Description
  121. End Sub
复制代码

评分

参与人数 1 +3 收起 理由
qinhuan66 + 3 很给力!谢谢。

查看全部评分

回复

使用道具 举报

发表于 2013-6-7 14:39 | 显示全部楼层
其实楼主可以用窗体来实现数据的输入嘛。
现在这样子,不可预料的情况很多,如果同时修改了报考时间这些数据,情况就又不一样了。
回复

使用道具 举报

发表于 2013-6-7 17:52 | 显示全部楼层
我呆会直接改个UPDATE的语句吧。
回复

使用道具 举报

 楼主| 发表于 2013-6-7 20:38 | 显示全部楼层
hwc2ycy 发表于 2013-6-7 14:39
其实楼主可以用窗体来实现数据的输入嘛。
现在这样子,不可预料的情况很多,如果同时修改了报考时间这些数 ...

老师和你探讨一下,经测试发现一个问题?为什么删除数据库打开时会出现以下提示呢?
2013-06-07_203231.jpg
确定后保存退出工作薄再重新打开工作薄又出现以下提示(在没录入添加到数据的情况下)

2013-06-07_203247.jpg
谢谢



回复

使用道具 举报

发表于 2013-6-7 20:40 | 显示全部楼层
你把附件再传下吧。


完整代码的。

回复

使用道具 举报

 楼主| 发表于 2013-6-7 20:44 | 显示全部楼层
hwc2ycy 发表于 2013-6-7 20:40
你把附件再传下吧。

报名登记表.rar (154.07 KB, 下载次数: 8)
回复

使用道具 举报

发表于 2013-6-7 20:44 | 显示全部楼层








回复

使用道具 举报

您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|Archiver|Excel精英培训 ( 豫ICP备11015029号 )

GMT+8, 2024-4-30 09:26 , Processed in 0.714853 second(s), 13 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

快速回复 返回顶部 返回列表