支持保存、修改、查询功能的产品数据录入系统（已解决，感谢大灰狼鼎力相助）

joen168

1、通过“信息录入”表向“产品数据库”表录入信息，其中单价、补货价要求为数字
2、货号、单位、操作人员为必填项目
3、点击“保存信息”按钮后，如保存成功，提示“保存成功”并在K2单元格显示“已保存”
4、对货号有重复的提示“该货号已有数据”并不予保存，经修改后符合保存条件后方可保存。
5、点击“清空并继续”按钮后清空A5：A14、B5：B14、……、K5：K14和K15单元格的内容，K2单元格显示“未保存”
6、点击“查询修改”按钮后提示输入“货号”（只能一个），录入后确认则在B2、A5:K5、K15显示需要修改货号的相关资料，K2单元格显示“查询修改中”
7、点击“查询修改”按钮后，“保存信息”按钮的文字变成“保存修改”
8、修改完成后，点击“保存修改”按钮，将自动将修改的信息更新储存到“产品数据库”对应的位置
9、修改保存成功，提示“修改成功”，清空B2、A5:K5、K15单元格的内容，“保存修改”按钮的文字变成“保存信息”，K2单元格显示“未保存”
10、在查询修改状态下，点击“清空并继续”，则清空B2、A5:K5、K15单元格的内容，“保存修改”按钮的文字变成“保存信息”，K2单元格显示“未保存”
11、在录入信息时，如A5：A14中允许有空白行，即可能是只录入1个或2个或其他数量的产品信息。
12、查询修改时，如输入的货号没有记录，则提示“暂无此货号的资料，请检查。”

[ 本帖最后由 joen168 于 2009-4-28 08:58 编辑 ]

joen168

这是单行录入的代码，使用起来也不太方便。

1、保存信息按钮的代码：
Option Explicit
Dim mRow
Public mDel As Boolean

Sub 矩形27_单击() '信息录入-保存信息
Dim mName
Dim rng  As Range, arr(13)
Sheets("信息录入").Shapes("Rectangle 27").Select
mName = Selection.Characters.Text '"保存修改"

Application.ScreenUpdating = False
With Sheets("信息录入")
    For Each rng In .Range("A5,F5,K15")
        If Len(rng.Value) = 0 Then
            MsgBox "货号、单位和操作人员必须要填写,请检查!", vbExclamation, Split(ThisWorkbook.Name, ".xls")(0)
            rng.Select
            Exit Sub
        End If
    Next
    arr(1) = .[A5]
    arr(2) = .[B5]
    arr(3) = .[C5]
    arr(4) = .[D5]
    arr(5) = .[E5]
    arr(6) = .[F5]
    arr(7) = .[G5]
    arr(8) = .[H5]
    arr(9) = .[I5]
    arr(10) = .[J5]
    arr(11) = .[K5]
    arr(12) = .[K15] ’每行都一样
    arr(13) = .[B2]’每行都一样
End With
If MsgBox("您确认数据都准确无误吗？", 4 + 64, "保存提示") = vbYes Then
Select Case mName
    Case "保存信息"
        With Sheets("产品数据库")
            If Application.WorksheetFunction.CountIf(.Range("B:B"), Sheets("信息录入").[A5]) > 0 Then
                MsgBox "货号: " & Sheets("信息录入").[A5] & " 已存在,请检查!", vbExclamation, Split(ThisWorkbook.Name, ".xls")(0)
                GoTo lab2
            End If
            arr(0) = "=row()-1"
            .Unprotect "0000"
            .Range("a" & .[a65536].End(xlUp).Row + 1).Resize(1, 14) = arr
            .Protect "0000"
        End With
        [K2] = "已保存"
        Application.ScreenUpdating = True
        MsgBox "货号: " & Sheets("信息录入").[A5] & " 保存完毕!", vbInformation, Split(ThisWorkbook.Name, ".xls")(0)
    Case "保存修改"
        With Sheets("产品数据库")
            arr(0) = "=row()-1"
            .Unprotect "0000"
            .Range("a" & mRow).Resize(1, 14) = arr
            .Protect "0000"
        End With
[K2] = "已修改保存"
        Application.ScreenUpdating = True
      
        MsgBox "货号: " & Sheets("信息录入").[A5] & " 修改完毕!", vbInformation, Split(ThisWorkbook.Name, ".xls")(0)
        mDel = True
End Select
lab2:
Selection.Characters.Text = "保存信息"
Sheets("信息录入").Shapes("Rectangle 27").Select
End If

2、查询修改按钮的代码：
End Sub
Sub 矩形28_单击() '信息录入-查询修改
Dim mIn, arr
mIn = InputBox(Chr(13) & Chr(13) & Chr(13) & Chr(13) & "请输入要查询修改的'货号':", Split(ThisWorkbook.Name, ".xls")(0) & "--查询修改")
If mIn = "" Then Exit Sub
On Error GoTo lab1
With Sheets("产品数据库")
    mRow = .Range("B:B").Find(what:=mIn, Lookat:=xlWhole).Row
    arr = .Range("A" & mRow & ":N" & mRow)
End With
With Sheets("信息录入")
    .Range("A5,B5,C5,D5,E5,F5,G5,H5,I5,J5,K5,K15,B2") = ""
    .[A5] = arr(1, 2)
    .[B5] = arr(1, 3)
    .[C5] = arr(1, 4)
    .[D5] = arr(1, 5)
    .[E5] = arr(1, 6)
    .[F5] = arr(1, 7)
    .[G5] = arr(1, 8)
    .[H5] = arr(1, 9)
    .[I5] = arr(1, 10)
    .[J5] = arr(1, 11)
    .[K5] = arr(1, 12)
.[K15] = arr(1, 13)
.[B2] = arr(1, 14)
    .Shapes("Rectangle 27").Select
    Selection.Characters.Text = "保存修改"
    .[C21].Select
    mDel = False
End With
        [K2] = "查询修改中"
Exit Sub
lab1:
    MsgBox "你要查询修改的货号: " & mIn & " 不存在,请检查!", vbExclamation, Split(ThisWorkbook.Name, ".xls")(0) & "-查询修改"
End Sub

3、清空并继续按钮的代码：
Private Sub CommandButton2_Click()
If MsgBox("您确认已经保存了吗？", 4 + 64, "清除提示") = vbYes Then
Range("A5:K5,B2,K15") = ""
[K2] = "未保存"
ActiveSheet.Shapes("Rectangle 27").Select
    Selection.Characters.Text = "保存信息"

End If
End Sub

987654321

工作量太大,

joen168

寻找“大灰狼”。。。。请继续关注。。

yf_992258

楼上说的是，有点工作量的，其实内容简单的！今天有点忙，草草做了一下，可能效率也不高，你先看看，偶下班了！可以消息我

joen168

感谢大灰狼大哥。。。。高。。。

joen168

谢谢大灰狼的鼎力相助。
我现在录入资料点击保存（目前是“保存修改”状态）提示：没有修改的字段。。同时“保存信息”按钮一直是“保存修改”。。（我已修改了）
点击“清空并继续”时“保存修改”不能改成“保存信息”（我已修改了）
点击“查询修改”时希望是弹出窗口输入货号然后进行查询或修改。。（这个问题不要紧。也可直接在表格上录入进行查询，有一点不好就是会弄错数据，所以建议弹出窗口，然后录入，录入正确后相关资料会显示在A5：K5的对应位置上）
存到“产品数据表”不需有录入表的底色。（这个有待解决。）

[ 本帖最后由 joen168 于 2009-4-27 18:26 编辑 ]

佑笾的守护

我也有同样的问题，等我下载看完后，看看能不能解决，

yf_992258

点击“查询修改”时希望是弹出窗口输入货号然后进行查询或修改。。（这个问题不要紧。也可直接在表格上录入进行查询，有一点不好就是会弄错数据，所以建议弹出窗口，然后录入，录入正确后相关资料会显示在A5：K5的对应位置上）
存到“产品数据表”不需有录入表的底色。（这个有待解决。）

1.为什么我没有用弹出的inputbox做，我的想法，弹出窗口只能输入一个单号，现在表格上输入可以从a5到a14,最多10行一起查询修改，假设你要改10条记录，你只要一次查询，同时修改完了按一次修改保存，用窗体的话你要做10次的！至于弄错数据的可能不大，只要你输入a5到a14范围，这总不会错吧，要是单个单元格输入错，那么你在窗体上也是输入同样会错
2.存到“产品数据表”不需有录入表的底色。我代码里用的是copy，你应该看的出，最简单的改一下循环就可以了，下面红色部分是原来的copy代码，隐掉，换成上面的循环即可  
For k = 1 To 11
   Sheets("产品数据库").Cells(lastrow + 1, k + 1) = arr(i, k)
  Next
  'Range("a" & i + 3 & ":k" & i + 3).Copy Sheets("产品数据库").Cells(lastrow + 1, 2)
还有个昨天忘记提示你了，为了方便输入，在操作员那里我做了数据有效性下拉，我想可能你看出来了

[ 本帖最后由 yf_992258 于 2009-4-28 08:43 编辑 ]

joen168

明白。我再试试。。非常感动。