[已解决]按编号批量录入的实现

ybc76 · 发表于 2013-3-11 12:45

如何实现从“B1”的编号到“D1”单元格中的编号以及F1，H1里的内容一次性录入到表2中，用VBA代码怎么写？？

求助文件.zip (12.44 KB, 下载次数: 5)

zjdh · 发表于 2013-3-11 13:00

求助文件.rar (11.54 KB, 下载次数: 26)

ybc76 · 发表于 2013-3-11 13:04

谢谢楼上的，不错，效率还真快啊，问题解决

那么的帅 · 发表于 2013-3-11 13:06

296682-VBA-数组填充数据.rar (13.14 KB, 下载次数: 15)

csmctjg · 发表于 2013-3-11 13:13

本帖最后由 csmctjg 于 2013-3-11 13:17 编辑

Sub SetValue()
Dim x%
With Sheets("Sheet1")
x = Mid(.[D1], 2, 9) - Mid(.[B1], 2, 9) + 1
End With
With Sheets("2")
.[A2] = Sheets("Sheet1").[B1]
.[A2].AutoFill .[A2].Resize(x), xlFillDefault
.[B2].Resize(x) = Sheets("Sheet1").[F1]
.[C2].Resize(x) = Sheets("Sheet1").[H1]
End With
End Sub

复制代码

ybc76 · 发表于 2013-3-11 13:25

本帖最后由 ybc76 于 2013-3-11 13:27 编辑

如果换成数据库呢，怎么修改

求助文件.zip (62.06 KB, 下载次数: 6)

ybc76 · 发表于 2013-3-11 13:40

已修改成功，谢谢楼上的热心帮助：Sub gongxusz()
Application.ScreenUpdating = False
Application.EnableEvents = False
  Dim cnn As New ADODB.Connection
  Dim rst As New ADODB.Recordset
  Stpath = "123.mdb"
cnn.Open "Provider=Microsoft.Jet.Oledb.4.0;data Source=" & ThisWorkbook.Path & "\" & Stpath
cnn.Execute "Delete * from pl where 编号>='" & Sheet1.Range("b1").Value & "'and 编号<='" & Sheet1.Range("d1").Value & "'"
Sql = "select * from pl where 编号>='" & Sheet1.Range("b1").Value & "'and 编号<='" & Sheet1.Range("d1").Value & "'"
  rst.Open Sql, cnn, adOpenKeyset, adLockOptimistic
A = Right(Sheet1.Range("B1"), 6)
B = Right(Sheet1.Range("D1"), 6)
For i = A To B

rst.AddNew
   rst.Fields("编号") = Left(IIf(Sheet1.Range("B1").Value = "", Null, Sheet1.Range("B1").Value), 1) & Format(i, "0000000")
   rst.Fields("单据名称") = Sheet1.Range("F1")
   rst.Fields("数量") = Sheet1.Range("H1")

   rst.Update
Next


Cells(3, 1).Select
  Application.EnableEvents = True
  Application.ScreenUpdating = True
End Sub

		自动登录	找回密码
密码			注册

[已解决]按编号批量录入的实现

相关帖子