数据自动录入VBA求编

wang94103

我有一个自己的库存管理表，现大约有40个产品，以后还要增加，每天需要记录出库，一张一张换着录入太麻烦，而且易出错。现想求助各位高手帮我编个VBA程序，能实现自动录入，先谢谢了！！！ 新建 Microsoft Excel 工作表.rar (34.71 KB, 下载次数: 5)   录入新数据时不能把原来的数据弄没了！接着原来的数据继续记录。或者帮我提供思路和用什么样的语句，我自己尝试着编写，谢谢了！！！

grf1973

搞了个简单的窗体录入，将就着用吧。

zez

这样行不行？

要看哪一个产品的帐，在AAA表的K2单元输入产品名称，然后按“高级筛选”按钮。
“库存保管帐”表中F列的公式自己向下拉

wang94103

grf1973 发表于 2013-6-25 09:16
搞了个简单的窗体录入，将就着用吧。

谢谢您这么快给我解答，谢谢！！基本实现了我的想法。但我还有几个问题请教：1、我原设想是在“录入”表录入完后运行宏实现自动录入的目的，现在用窗体了，“录入”表是否可以删除不要？？   2、为何“发出数量”或“收入数量”不能为空，必须都填上，（没有也得填0），否则录入后计算错误       3、换输入框后，输入法必须重新选择，如何能解决？？（如：：摘要“我填完锦州，再选”备注“时输入法又变回英文了。）      4、在同一窗体一次录入多个产品是否可行？是不是我把第一个的代码复制一下，修改变量就可以了？？（我把窗体修改了一下，看了也许会明白）。再次感谢您的帮助！！对于新问题盼复！！

wang94103

zez 发表于 2013-6-25 09:19
这样行不行？

要看哪一个产品的帐，在AAA表的K2单元输入产品名称，然后按“高级筛选”按钮。

感谢您的帮助，和我的想法不太一样，但我还是学到了新东西，谢谢！！！

grf1973

那这样还是在“录入”表中录完后一次导入吧。用窗体不适合你想一次输入N条记录的情况。具体代码我来弄一下。

grf1973

1. Sub 录入()
   
2.     r = [a65536].End(3).Row
   
3.     arr = Range("a4:I" & r)
   
4.     For i = 1 To UBound(arr)
   
5.         sh = arr(i, 1)
   
6.         With Sheets(sh)
   
7.             r1 = .[a65536].End(3).Row + 1
   
8.             .Cells(r1, 1).Resize(1, 4).Value = Array(arr(i, 2), arr(i, 3), arr(i, 4), arr(i, 5))
   
9.             .Cells(r1, 6).Resize(1, 3).Value = Array(arr(i, 7), arr(i, 8), arr(i, 9))
   
10.         End With
    
11.     Next
    
12.     MsgBox "已添加" & UBound(arr) & "条记录"
    
13.    
    
14. End Sub
    
15. 
    
16. Sub 清空()
    
17.   r = [a65536].End(3).Row
    
18.   Range("a4:I" & r).ClearContents
    
19. End Sub
    

复制代码

grf1973

请看附件。前提是分表已经做好。不然会报错。而且里面数据填写是否正确没有检查。

hehex

wang94103 发表于 2013-6-25 14:55
谢谢您这么快给我解答，谢谢！！基本实现了我的想法。但我还有几个问题请教：1、我原设想是在“录入”表录 ...

还是原来的想法吧，直接填写录入表。然后点按钮，分别录入各表，在录入之后自动清除录入表的内容。

1. Option Explicit
   
2. 
   
3. 
   
4. Sub 录入()
   
5.     Application.ScreenUpdating = False
   
6.     Dim conn As Object, xrow As Long, i As Long, sqlstr$, sAdress$, sht As Worksheet
   
7.     Set conn = CreateObject("adodb.connection")
   
8.     conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties=Excel 8.0;Data Source=" & ThisWorkbook.FullName
   
9.     sAdress = Range("a3", Cells(Rows.Count, "i").End(xlUp)).Address(0, 0)
   
10.    
    
11.     For Each sht In Worksheets
    
12.         If sht.Name <> "录入" Then
    
13.             sqlstr = "Select 日期,摘要,收入数量,发出数量,库存,备注,批号,小号 from [录入$" & sAdress & "] where 产品 = '" & sht.Name & "'"
    
14.            
    
15.             With sht
    
16.                 xrow = .[a65535].End(xlUp).Row + 1
    
17.                 .Range("a" & xrow).CopyFromRecordset conn.Execute(sqlstr)
    
18.             End With
    
19.         End If
    
20.     Next
    
21.     Sheets("录入").Activate
    
22.     Range(Range("a4"), Cells(Rows.Count, "i")).ClearContents
    
23.     Set conn = Nothing
    
24.     Application.ScreenUpdating = True
    
25. End Sub
    
26. 
    
27. 
    

复制代码

hehex

hehex 发表于 2013-6-25 16:18
还是原来的想法吧，直接填写录入表。然后点按钮，分别录入各表，在录入之后自动清除录入表的内容。

请参考附件如下：