ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

EH搜索     
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 Excel Home精品图文教程库
Excel不给力? 何不试试FoxTable! Excel 2016函数公式学习大典 Office知识技巧免费学 打造核心竞争力的职场宝典
300集Office 2010微视频教程 Tableau-数据可视化工具 精品推荐-800套精选PPT模板,点击获取 ExcelHome出品 - VBA代码宝免费下载
你的Excel 2010实战技巧学习锦囊 欲罢不能, 过目难忘的 Office 新界面 Excel VBA经典代码实践指南
查看: 110|回复: 8

[求助] 如何将二段代码合并在一起

[复制链接]

TA的精华主题

TA的得分主题

发表于 2020-11-22 22:39 | 显示全部楼层 |阅读模式
各位老师好!!下面二段代码分别运行可以,但怎么才能将它们合并在一起运行?

Dim cnn As New ADODB.Connection
Dim rst As New ADODB.Recordset

Private Sub UserForm_Initialize() '
Stpath = ThisWorkbook.Path & "\数据库.mdb"
   cnn.Open "provider=Microsoft.jet.OLEDB.4.0;data source=" & Stpath
   Sql = "Select distinct 收据编号  from 资料 order by 收据编号"
  
   rst.Open Sql, cnn, adOpenKeyset, adLockOptimistic
   rst.MoveFirst
    Do Until rst.EOF
        'Label5 = Format(Val(rst.Fields("收据编号")) + 1, "00000000")
        Label12 = Sheet1.Range("a7")
        Label3 = Sheet1.Range("a6")
        Label4 = Format(Date, "yyyy年mm月dd日")
      
        rst.MoveNext
   Loop
rst.Close
cnn.Close
Set rst = Nothing
Set cnn = Nothing

End Sub


Private Sub UserForm_Initialize() '
Stpath = ThisWorkbook.Path & "\数据库.mdb"
   cnn.Open "provider=Microsoft.jet.OLEDB.4.0;data source=" & Stpath
   Sql = "Select distinct 名称 from 款项来源 order by 名称"
   rst.Open Sql, cnn, adOpenKeyset, adLockOptimistic
   rst.MoveFirst
    Do Until rst.EOF
      
        ComboBox1.AddItem rst("名称")
        rst.MoveNext
   Loop
rst.Close
cnn.Close
Set rst = Nothing
Set cnn = Nothing

End Sub


关键点在于同一个数据库,同一个窗体,要引用数据库中二个不同表的字段。
请各们大侠指点一下,谢谢!!!

求助.zip

58.65 KB, 下载次数: 3

TA的精华主题

TA的得分主题

发表于 2020-11-23 00:26 | 显示全部楼层
有点不是很明白,为什么不停循环给Label写值,你不干脆取最后一个值就完了吗?循环写Label的结果就是写最后的值

TA的精华主题

TA的得分主题

发表于 2020-11-23 00:35 | 显示全部楼层
本帖最后由 microyip 于 2020-11-23 11:21 编辑
  1. Dim cnn As New ADODB.Connection
  2. Dim rst As New ADODB.Recordset

  3. Private Sub UserForm_Initialize() '
  4.     Dim sPath As String, sSQL As String, vRS As Variant, vList As Variant, nI As Double
  5.    
  6.     sPath = ThisWorkbook.Path & "\数据库.mdb"
  7.     cnn.Open "provider=Microsoft.jet.OLEDB.4.0;data source=" & sPath
  8.     sSQL = "Select Max([收据编号]) From [资料]"
  9.    
  10.     rst.Open sSQL, cnn, adOpenKeyset, adLockOptimistic
  11.     If Not (rst.EOF And rst.BOF) Then
  12.         vRS = rst.GetRows
  13.         Label5 = Format(Val(vRS(0, 0)) + 1, "00000000")
  14.     Else
  15.         Label5 = "00000001"
  16.     End If
  17.     Label12 = Sheet1.Range("a7")
  18.     Label3 = Sheet1.Range("a6")
  19.     Label4 = Format(Date, "yyyy年mm月dd日")
  20.     rst.Close

  21.     sSQL = "Select distinct 名称 from 款项来源 order by 名称"
  22.     rst.Open sSQL, cnn, adOpenKeyset, adLockOptimistic
  23.     If Not (rst.EOF And rst.BOF) Then
  24.         vRS = rst.GetRows
  25.         ReDim vList(1 To UBound(vRS, 2) + 1)
  26.         For nI = 0 To UBound(vRS, 2)
  27.             If Not IsNull(vRS(0, nI)) Then vList(nI + 1) = vRS(0, nI)
  28.         Next
  29.         ComboBox1.List = vList
  30.     End If
  31.     rst.Close
  32.     cnn.Close
  33.     Set rst = Nothing
  34.     Set cnn = Nothing

  35. End Sub
复制代码

TA的精华主题

TA的得分主题

发表于 2020-11-23 00:39 | 显示全部楼层
附上附件以供参考

收据(by.micro).rar

17.85 KB, 下载次数: 6

评分

参与人数 1鲜花 +2 收起 理由
hqlin65 + 2 太强大了

查看全部评分

TA的精华主题

TA的得分主题

 楼主| 发表于 2020-11-23 09:46 | 显示全部楼层

TA的精华主题

TA的得分主题

 楼主| 发表于 2020-11-23 17:29 | 显示全部楼层
microyip 发表于 2020-11-23 00:39
附上附件以供参考

我今天捣鼓了一天,都没办法把窗体上的资料:日期、收据编号、客户、事由、备注、制单人、金额、款项来源等保存到数据库中。如果您有空请再帮帮我。实在麻烦您了,谢谢!!

TA的精华主题

TA的得分主题

 楼主| 发表于 2020-11-23 22:34 | 显示全部楼层
microyip 发表于 2020-11-23 00:39
附上附件以供参考

老师您好!我凑了下面一段代码,可以将窗体上的资料保存到数据库中了,但我想要加“收据编号”相同不能保存的提示,一直弄不好,您好能不能帮我看一下?谢谢!

Private Sub CommandButton1_Click()
Dim sPath As String, sSQL As String, vRS As Variant, vList As Variant, nI As Double
sPath = ThisWorkbook.Path & "\数据库.mdb"
    cnn.Open "provider=Microsoft.jet.OLEDB.4.0;data source=" & sPath
sSQL = "Select * from 资料 "
RSt.Open sSQL, cnn, adOpenKeyset, adLockOptimistic

With RSt
      .AddNew
    .Fields("日期") = Label4
    .Fields("客户") = TextBox1.Text
    .Fields("事由") = TextBox2.Text
    .Fields("备注") = TextBox3.Text
    .Fields("金额") = TextBox4
     .Fields("款项来源") = ComboBox1.Value
    .Fields("制单人") = Label12
    .Fields("收据编号") = Label5
        .Update
        MsgBox "已推送财务!"
    End With
     TextBox1.Text = ""
     TextBox2.Text = ""
     TextBox3.Text = ""
     TextBox4.Text = ""
     ComboBox1.Value = ""
     RSt.Close
    cnn.Close
    Set RSt = Nothing
    Set cnn = Nothing
    Call UserForm_Initialize
End Sub

TA的精华主题

TA的得分主题

发表于 2020-11-24 09:35 | 显示全部楼层
hqlin65 发表于 2020-11-23 22:34
老师您好!我凑了下面一段代码,可以将窗体上的资料保存到数据库中了,但我想要加“收据编号”相同不能保 ...

1、收据编号定义为唯一索引,如果有重复的会报错

比如用代码

Sub A()
    Dim cnn, rs, Sql$
    Set cnn = CreateObject("ADODB.Connection")
    Set rs = CreateObject("adodb.Recordset")
    cnn.Open "provider=microsoft.ace.oledb.12.0;data source=" & ThisWorkbook.Path & "\test.mdb"
    On Error GoTo 100
    Sql = "select * from 表1"
    rs.Open Sql, cnn, 1, 3
    With rs
        .AddNew
        .Fields("id") = 3
        .Update
    End With
    Set rs = Nothing
    Set cnn = Nothing
    MsgBox "插入OK"
    Exit Sub
100:
    MsgBox Err.Description & vbLf & Err.Number
    Set rs = Nothing
    Set cnn = Nothing
End Sub

2、插入前先查询一下是否有重复的单据编号
Sub b()
    Dim cnn, rs, Sql$
    Set cnn = CreateObject("ADODB.Connection")
    Set rs = CreateObject("adodb.Recordset")
    cnn.Open "provider=microsoft.ace.oledb.12.0;data source=" & ThisWorkbook.Path & "\test.mdb"
    Sql = "select * from 表1 where id=5"
    rs.Open Sql, cnn, 1, 3
    If rs.RecordCount = 0 Then
        With rs
            .AddNew
            .Fields("id") = 5
            .Update
        End With
    Else
        MsgBox "id 重复不能录入"
        Exit Sub
    End If
    Set rs = Nothing
    Set cnn = Nothing
    MsgBox "插入OK"
End Sub

TA的精华主题

TA的得分主题

 楼主| 发表于 2020-11-24 16:50 | 显示全部楼层
魂断蓝桥 发表于 2020-11-24 09:35
1、收据编号定义为唯一索引,如果有重复的会报错

比如用代码

非常感谢您的帮助,我试试看。再次感谢!
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

关注官方微信,每天学会一个新技能

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2020-12-6 02:07 , Processed in 0.089915 second(s), 18 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 1999-2021 Wooffice Inc.

   

沪公网安备 31011702000001号 沪ICP备11019229号

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:徐怀玉律师 李志群律师

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