VBA学员必做: 入库单的录入、查询、删除和修改

不看不看 · 发表于 2007-12-20 18:04

"物品代码" 该填到那里那？

兰色幻想 · 发表于 2007-12-20 18:08

<div class="msgheader">QUOTE:</div><div class="msgborder">以下是引用不看不看在2007-12-20 18:04:00的发言： "物品代码" 该填到那里那？</div>数据库中少了这个列[em04],已修正. 谁方便在群里发一个补充说明吧,让大家自已插入一个物品代码列

[此贴子已经被作者于2007-12-20 18:09:42编辑过]

wzcad · 发表于 2007-12-20 18:10

做了半天出不来，

不看不看 · 发表于 2007-12-20 18:12

<table cellspacing="0" cellpadding="0" width="846" border="0" xstr="" style="WIDTH: 636pt; BORDER-COLLAPSE: collapse;"><colgroup><col width="82" style="WIDTH: 62pt; mso-width-source: userset; mso-width-alt: 2624;"></col><col span="2" width="94" style="WIDTH: 71pt; mso-width-source: userset; mso-width-alt: 3008;"></col><col span="8" width="72" style="WIDTH: 54pt;"></col></colgroup><tbody><tr height="19" style="HEIGHT: 14.25pt;"><td class="xl22" width="82" height="19" style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext 0.5pt solid; BORDER-LEFT: windowtext 0.5pt solid; WIDTH: 62pt; BORDER-BOTTOM: windowtext 0.5pt solid; HEIGHT: 14.25pt; BACKGROUND-COLOR: silver;">入库日期</td><td class="xl22" width="94" style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext 0.5pt solid; BORDER-LEFT: windowtext; WIDTH: 71pt; BORDER-BOTTOM: windowtext 0.5pt solid; BACKGROUND-COLOR: silver;">入库单号码</td><td class="xl22" width="94" style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext 0.5pt solid; BORDER-LEFT: windowtext; WIDTH: 71pt; BORDER-BOTTOM: windowtext 0.5pt solid; BACKGROUND-COLOR: silver;">物品代码</td><td class="xl22" width="72" style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext 0.5pt solid; BORDER-LEFT: windowtext; WIDTH: 54pt; BORDER-BOTTOM: windowtext 0.5pt solid; BACKGROUND-COLOR: silver;">物品名称</td><td class="xl22" width="72" style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext 0.5pt solid; BORDER-LEFT: windowtext; WIDTH: 54pt; BORDER-BOTTOM: windowtext 0.5pt solid; BACKGROUND-COLOR: silver;">数量</td><td class="xl22" width="72" style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext 0.5pt solid; BORDER-LEFT: windowtext; WIDTH: 54pt; BORDER-BOTTOM: windowtext 0.5pt solid; BACKGROUND-COLOR: silver;">单价</td><td class="xl22" width="72" style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext 0.5pt solid; BORDER-LEFT: windowtext; WIDTH: 54pt; BORDER-BOTTOM: windowtext 0.5pt solid; BACKGROUND-COLOR: silver;">金额</td><td class="xl22" width="72" style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext 0.5pt solid; BORDER-LEFT: windowtext; WIDTH: 54pt; BORDER-BOTTOM: windowtext 0.5pt solid; BACKGROUND-COLOR: silver;">备注</td><td class="xl22" width="72" style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext 0.5pt solid; BORDER-LEFT: windowtext; WIDTH: 54pt; BORDER-BOTTOM: windowtext 0.5pt solid; BACKGROUND-COLOR: silver;">制单</td><td class="xl22" width="72" style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext 0.5pt solid; BORDER-LEFT: windowtext; WIDTH: 54pt; BORDER-BOTTOM: windowtext 0.5pt solid; BACKGROUND-COLOR: silver;">录入</td><td class="xl22" width="72" style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext 0.5pt solid; BORDER-LEFT: windowtext; WIDTH: 54pt; BORDER-BOTTOM: windowtext 0.5pt solid; BACKGROUND-COLOR: silver;">审核</td></tr></tbody></table>

onlyou888 · 发表于 2007-12-20 18:46

[em01]

皓雪无痕 · 发表于 2007-12-20 19:08

用的方法比较笨[em04]Sub 输入() Dim x As Long Dim k% With Sheets("入库明细表")    x = .Range("a65536").End(xlUp).Row + 1   For k = 6 To 7    .Cells(x, 1) = Range("E3")    .Cells(x, 2) = Range("G3")    .Range(.Cells(x, 3), .Cells(x, 8)) = Range(Cells(k, 2), Cells(k, 7)).Value    .Cells(x, 8) = Range("C13")    .Cells(x, 9) = Range("E13")    .Cells(x, 10) = Range("G13")    x = x + 1         MsgBox "输入成功!"    Next k    Range("E3") = ""    Range("B6:G10") = ""    Range("C13") = ""    Range("E13") = ""    Range("G13") = "" End With End Sub－－－－－－－－－－－－－－－－－全贴出来比较多，就贴一个代码吧[em01]

GE48zo3x.rar (10.67 KB, 下载次数: 66)

sophiemery · 发表于 2007-12-20 19:20

好好温习一下!

晓 · 发表于 2007-12-20 20:02

终于做好了，不过那个“修改”的，如果增加或删除就不会做了。

alo1RuUf.rar (11.99 KB, 下载次数: 34)

2007-12-24 10:32 上传

点击文件名下载附件
 [em04][em04]Sub 输入() With Sheets("入库单")   Dim x As Integer   Dim y As Integer   Dim i As Integer   Dim j As Integer   If .Range("G3") = Empty Then     MsgBox "入库单号码不能为空"   Else    y = .Range("b11").End(xlUp).Row     For j = 6 To y       x = Sheets("入库明细表").Range("a65536").End(xlUp).Row + 1       For i = 2 To 7         Sheets("入库明细表").Cells(x, i + 1) = .Cells(j, i)       Next       Sheets("入库明细表").Cells(x, 1) = .Range("e3")       Sheets("入库明细表").Cells(x, 2) = .Range("g3")       Sheets("入库明细表").Cells(x, 9) = .Range("c13")       Sheets("入库明细表").Cells(x, 10) = .Range("e13")       Sheets("入库明细表").Cells(x, 11) = .Range("g13")     Next     MsgBox "输入成功！"     .Range("b6:g10") = ""     .Range("b6").Select   End If End With End Sub Sub 查询() With Sheets("入库单") .Range("b6:g10") = ""   Dim MRG As Range   Dim i As Integer   Dim x As Integer   Dim y As Integer   If .Range("G3") = Empty Then     MsgBox "入库单号码不能为空"   Else     y = .Range("b11").End(xlUp).Row + 1     Set MRG = Sheets("入库明细表").Range("b:b").Find(.Range("g3"), lookat:=xlWhole)     If MRG Is Nothing Then       MsgBox "查找不到!"     Else       x = Sheets("入库明细表").Range("b:b").Find(.Range("g3")).Row       Do         Set MRG = Sheets("入库明细表").Range("b:b").FindNext(MRG)         y = .Range("b11").End(xlUp).Row + 1         k = Sheets("入库明细表").Range("b:b").FindNext(MRG).Row         For i = 2 To 7           .Cells(y, i) = Sheets("入库明细表").Cells(k, i + 1)         Next         .Range("e3") = Sheets("入库明细表").Cells(x, 1)         .Range("c13") = Sheets("入库明细表").Cells(x, 9)         .Range("e13") = Sheets("入库明细表").Cells(x, 10)         .Range("g13") = Sheets("入库明细表").Cells(x, 11)       Loop Until MRG.Row = x     End If   End If End With End Sub Sub 删除() With Sheets("入库单")   Dim MRG As Range   Dim x As Integer   If .Range("G3") = Empty Then     MsgBox "入库单号码不能为空"   Else     Set MRG = Sheets("入库明细表").Range("b:b").Find(.Range("g3"), lookat:=xlWhole)     If MRG Is Nothing Then       MsgBox "查找不到!"     Else       x = Sheets("入库明细表").Range("a65536").End(xlUp).Row       For i = 5 To x         If Sheets("入库明细表").Cells(i, 2) = "" Then Exit For           If Sheets("入库明细表").Cells(i, 2) = .Range("g3") Then             Sheets("入库明细表").Rows(i).Delete             i = i - 1         End If       Next     End If     MsgBox "删除成功！"   End If End With End Sub Sub 修改() With Sheets("入库单")   Dim x As Integer   Dim i As Integer   Dim j As Integer   Dim MRG As Range   If .Range("G3") = Empty Then     MsgBox "入库单号码不能为空"   Else     y = .Range("b11").End(xlUp).Row + 1     Set MRG = Sheets("入库明细表").Range("b:b").Find(.Range("g3"), lookat:=xlWhole)     If MRG Is Nothing Then       MsgBox "查找不到!"     Else       x = Sheets("入库明细表").Range("b:b").Find(.Range("g3")).Row       Do         Set MRG = Sheets("入库明细表").Range("b:b").FindNext(MRG)         k = Sheets("入库明细表").Range("b:b").FindNext(MRG).Row         For i = 2 To 7            Sheets("入库明细表").Cells(k, i + 1) = .Cells(k + 1, i)         Next         Sheets("入库明细表").Cells(k, 1) = .Range("e3")         Sheets("入库明细表").Cells(k, 9) = .Range("c13")         Sheets("入库明细表").Cells(k, 10) = .Range("e13")         Sheets("入库明细表").Cells(k, 11) = .Range("g13")       Loop Until MRG.Row = x       MsgBox "修改成功！"     End If   End If End With End Sub

[此贴子已经被作者于2007-12-24 10:34:18编辑过]

jingletxj · 发表于 2007-12-20 20:07

争取完成

不看不看 · 发表于 2007-12-20 20:23

是交到作业上交板块吗？

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

[习题] VBA学员必做: 入库单的录入、查询、删除和修改

浏览过的版块