|
|
外部数据复制.rar
(26.98 KB, 下载次数: 6)
RegisterRC5inPlace.rar
(411 Bytes, 下载次数: 4)
vb_cairo_sqlite.rar
(1.08 MB, 下载次数: 4)
vbRichClient5.rar
(1 MB, 下载次数: 4)
操作sqlite例，需要vb_cairo_sqlite.dll（不用注册）与vbRichClient5.dll(需注册)放在一个目录
返回数据给数据库，你需要很高的权限，并不赞成你这种做法
数据库一旦有变化，是永久性的，一般不可逆。
如果你图中的sql是自己写的，我觉得那这个问题你自己就能解决了。
写个代码你参考一下吧。
我这里没有sql server数据，只能用sqlite 模拟一下了。
Sub a()
Dim cnn As New cConnection, sql$, s$, bt$
Dim rs As New cRecordset, i%, j%
If [A2] = "" Then Call b '第一次运行直接copy 数据
Dim arr
arr = [A1].CurrentRegion
For i = 1 To UBound(arr, 2)
s = s & "[" & arr(1, i) & "],"
Next
s = s & " primary key([采购单创建日期],[请购/委外单号],[单号])"
sql = "CREATE TABLE T1(" & s & ")" '
cnn.CreateNewDB ":memory:" '建立内存数据库，这样速度快一些，也不会占用你的磁盘空间。
cnn.Execute sql '建立表，字段就是你第二张表的内容
cnn.BeginTrans '开启事物
s = ""
For i = 2 To UBound(arr) ' 插入第二张表的数据,带备注栏的。
For j = 1 To UBound(arr, 2)
s = s & MYV(arr(i, j)) & ","
Next
s = Left(s, Len(s) - 1)
sql = "INSERT INTO T1 VALUES(" & s & ")"
cnn.Execute sql
s = ""
Next
arr = Sheet1.[A1].CurrentRegion
For j = 1 To UBound(arr, 2)
bt = bt & "[" & arr(1, j) & "],"
Next
bt = Left(bt, Len(bt) - 1)
s = ""
For i = 2 To UBound(arr) 对第一张表的数据循环
sql = "SELECT * FROM T1 WHERE [采购单创建日期]=" & MYV(arr(i, 1)) _
& " AND [请购/委外单号]=" & MYV(arr(i, 2)) _
& " AND [单号]=" & MYV(arr(i, 3))
rs.OpenRecordset sql, cnn
If rs.RecordCount = 0 Then '如果数据库中没有主键的数据，就是增加的操作
s = ""
For j = 1 To UBound(arr, 2)
s = s & MYV(arr(i, j)) & ","
Next
s = Left(s, Len(s) - 1)
sql = "REPLACE INTO T1(" & bt & ") VALUES(" & s & ")" '在数据库中新增此条数据
cnn.Execute sql
s = ""
Else '如果有，就是修改的操作，只修改第一张表中的字段，你的备注栏内容会保留下来的。
s = ""
For j = 4 To UBound(arr, 2)
s = s & "[" & arr(1, j) & "]=" & MYV(arr(i, j)) & ","
Next
s = Left(s, Len(s) - 1)
sql = ""
sql = "UPDATE T1 SET " & s '更新数据
cnn.Execute sql
End If
Next
cnn.CommitTrans '提交事务
[A2:Y9999] = ""
sql = "SELECT * FROM T1"
rs.OpenRecordset sql, cnn
[A2].CopyFromRecordset rs.DataSource '返回数据带备注栏
Set rs = Nothing
Set cnn = Nothing
End Sub
Sub b()
Dim r
r = Sheet1.[a99999].End(3).Row
Sheet1.Range("a2:v" & r).Copy [A2]
End Sub
Public Function MYV(myt)
If Trim(Len(myt)) = 0 Then
MYV = "''"
ElseIf TypeName(myt) = "String" Then
MYV = "'" & myt & "'"
ElseIf IsDate(myt) Then
MYV = "'" & Format(myt, "YYYY-MM-DD") & "'"
Else
MYV = myt
End If
End Function
|
评分
-
1
查看全部评分
-
|
楼主: exc-led
沪公网安备 31011702000001号 沪ICP备11019229号-2
楼主
发表于 2018-9-12 11:11
