窗体录入问题

54321shenyong · 发表于 2019-9-30 09:44

dongjuwen 发表于 2019-9-30 09:18
控件多了，有的时候对应到单元格会出错，借助Array写入，代码简化的同时也把出错率降低了。仅供参考！
Pri ...

优化的代码可用，不过问题依然存在，请配合标题下说明看截图

dongjuwen · 发表于 2019-9-30 09:47

54321shenyong 发表于 2019-9-30 09:44
优化的代码可用，不过问题依然存在，请配合标题下说明看截图

把Worksheet_Change里编号的代码删除了。

54321shenyong · 发表于 2019-9-30 09:51

本帖最后由 54321shenyong 于 2019-9-30 10:00 编辑

microyip 发表于 2019-9-30 09:39
说白了，就是伸手党，没意思

对这说法表示不服，虽然是各种方式得来的代码，也在努力的理解学习和掌握进行消化，请对待比自身进阶低的学习者，保持低调才是正确的心态。每一位掌握了技能的，都是从小白一步一步走过来的，只是学习的方法和途径有差异而已，这帖子是求助帖，不是伸手帖，请分辨明白。

54321shenyong · 发表于 2019-9-30 10:20

本帖最后由 54321shenyong 于 2019-9-30 10:27 编辑

dongjuwen 发表于 2019-9-30 09:18
控件多了，有的时候对应到单元格会出错，借助Array写入，代码简化的同时也把出错率降低了。仅供参考！
Pri ...

请问：MsgBox提示代码怎么排除“当日单号” ，“三级目录”，“对方单位”这三项的提示呢？这三项不是必选项，特殊情况下才需要填写

dongjuwen · 发表于 2019-9-30 10:34

54321shenyong 发表于 2019-9-30 10:20
请问：MsgBox提示代码怎么排除“当日单号” ，“三级目录”，“对方单位”这三项的提示呢？这三项不是必 ...

for i=^next
是对各控件的循环，对应一下ar(i)就可以排除了

dongjuwen · 发表于 2019-9-30 10:41

同时还要把需要排除的控件的change事件删除了，要不然也不行的

dongjuwen · 发表于 2019-9-30 10:52

Private Sub CmdOk_Click()    '写入工作表
ar = Array("日期", "当日单号", "一级类目", "二级类目", "三级类目", "对方单位", "概要", "所属项目", "经办人", "付款人", "资金来源")
br = Array("日期", "一级类目", "二级类目", "经办人", "付款人", "资金来源", "对方单位", "所属项目")
For i = 0 To UBound(br)
      If Me.Controls(br(i)) = "" Then
         MsgBox "请录入：" & br(i), vbCritical, "友情提示"
         Me.Controls(br(i)).SetFocus
         Exit Sub
      End If
Next

Dim xrow As Long                   '定义变量xrow，用来保存要输入数据的工作表行号
xrow = Range("A4").CurrentRegion.Rows.Count + 3  '求工作表中第1条空行的行号
For i = 0 To UBound(ar)
      If i > 6 Then n = 4 Else n = 3
      Cells(xrow, i + n) = Me.Controls(ar(i)).Value
      Me.Controls(ar(i)).Value = ""
Next
End Sub

lsdongjh · 发表于 2019-9-30 12:07

改个思路

Function CheckValIsNull() As Boolean
CheckValIsNull = True
'判断录入项目是否为空
If Trim(日期.Text) = "" Then
MsgBox "请录入日期!", vbInformation, "友情提示"
日期.SetFocus
Exit Function
End If
'判断当日单号是否为空
If Trim(当日单号.Value) = "" Then
MsgBox "请录入单号!", vbInformation, "友情提示"
当日单号.SetFocus
Exit Function
End If
'判断一级类目是否为空
If Trim(一级类目.Value) = "" Then
MsgBox "请录入一级类目!", vbInformation, "友情提示"
一级类目.SetFocus
Exit Function
End If
'判断二级类目是否为空
If Trim(二级类目.Value) = "" Then
MsgBox "请录入二级类目!", vbInformation, "友情提示"
二级类目.SetFocus
Exit Function
End If
'判断详细描述是否为空
If Trim(概要.Text) = "" Then
MsgBox "请录入详细描述!", vbInformation, "友情提示"
概要.SetFocus
Exit Function
End If
'判断详细描述是否为空
If Trim(所属项目.Value) = "" Then
MsgBox "请录入所属项目!", vbInformation, "友情提示"
所属项目.SetFocus
Exit Function
End If
'判断付款人是否为空
If Trim(付款人.Value) = "" Then
MsgBox "请录入付款人!", vbInformation, "友情提示"
付款人.SetFocus
Exit Function
End If
'判断资金来源是否为空
If Trim(资金来源.Value) = "" Then
MsgBox "请录入资金来源!", vbInformation, "友情提示"
资金来源.SetFocus
Exit Function
End If
CheckValIsNull = False
End Function
'三级联动菜单
Private Sub CmdOk_Click() '写入工作表
Dim arrResult As Variant, xrow As Long
If CheckValIsNull Then Exit Sub
'求工作表中第1条空行的行号
xrow = Range("B" & Rows.Count).End(xlUp).Row + 1
If xrow < 5 Then xrow = 5
ReDim arrResult(1 To 1, 1 To 13)
arrResult(1, 1) = xrow - 4
arrResult(1, 2) = 日期.Value
arrResult(1, 3) = 当日单号.Value
arrResult(1, 4) = 一级类目.Value
arrResult(1, 5) = 二级类目.Value
arrResult(1, 6) = 三级类目.Value
arrResult(1, 7) = 对方单位.Value
arrResult(1, 8) = 概要.Value
arrResult(1, 10) = 所属项目.Value
arrResult(1, 11) = 经办人.Value
arrResult(1, 12) = 付款人.Value
arrResult(1, 13) = 资金来源.Value
Range("B" & xrow).Resize(1, 13) = arrResult
'将窗体中输入的数据清除，等待下次输入
日期.Value = ""
当日单号.Value = ""
一级类目.Value = ""
二级类目.Value = ""
三级类目.Value = ""
对方单位.Value = ""
概要.Value = ""
所属项目.Value = ""
经办人.Value = ""
付款人.Value = ""
资金来源.Value = ""
End Sub

复制代码

54321shenyong · 发表于 2019-9-30 17:40

本帖最后由 54321shenyong 于 2019-9-30 17:55 编辑

dongjuwen 发表于 2019-9-30 10:52
Private Sub CmdOk_Click() '写入工作表
ar = Array("日期", "当日单号", "一级类目", "二级类目" ...

研究对比了一下午，二级目录和三级目录用这个代码都不会写入工作表，基础知识太差，实在汗颜

还有，请问Worksheet_Change 事件里面的字符提取公式是应该移动位置还是该怎么修改代码呢？

我的思路是：I列数据通过窗体写入之后，再通过Worksheet_Change事件运行代码，把数字提取到J列不知道这个思路对不对

54321shenyong · 发表于 2019-9-30 17:48

lsdongjh 发表于 2019-9-30 12:07
改个思路

dongjuwen老师的代码找不到二级、三级目录不写入的原因

这个代码运行时“I列”的字符提取公式又没运行，老师的思路架构也没整明白，整个下午都在研究学习

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

[求助] 窗体录入问题