[已解决]数据录入代码，判断提醒

haryzbs

这是我的一段录入数据的代码：

Sub 录入()
Dim i, j
i = Sheets("登记").Cells(Rows.Count, 2).End(xlUp).Row
j = Sheets(Sheets("登记").Cells(3, 7).Value & "台账").Cells(Rows.Count, 1).End(xlUp).Row + 1
Sheets("登记").Range("b5:h" & i).Copy Sheets(Sheets("登记").Cells(3, 7).Value & "台账").Range("a" & j)
Sheets("登记").Range("i5:j" & i).Copy Sheets(Sheets("登记").Cells(3, 7).Value & "台账").Range("i" & j)
MsgBox "数据已成功录入到" & "《" & Sheets("登记").Cells(3, 7).Value & "台账》工作表"
   [B5:J9] = ""
End Sub

我想在保存的时候需要判断某些位置是否有数据之后再保存，如果没有数据就添加文字提醒，麻烦大家帮我看一下

最佳答案

月排行榜 / 总排行榜

810126769

2014-4-4 09:18

haryzbs 发表于 2014-4-4 08:39
您好，附件已经上传，我就是在第一个登记表格中，如果一个信息没有登记的话，选择就要保存4行的所有文字到 ...

看了好久，好象现在猜出你的要求了：
请测试，看是不是要这样的效果：
考勤-员工请销假电子台账.rar (139.73 KB, 下载次数: 38)

2014-4-4 09:18 上传

点击文件名下载附件

1. Sub 录入()
   
2. Dim i, j, rng As Range
   
3. i = Sheets("登记").Cells(Rows.Count, 2).End(xlUp).Row
   
4. j = Sheets(Sheets("登记").Cells(3, 7).Value & "台账").Cells(Rows.Count, 1).End(xlUp).Row + 1
   
5.   For Each rng In Sheet1.Range("b5:j9")
   
6.       If rng = "" Then
   
7.          MsgBox "请输入对应空白项数据之后再保存"
   
8.          Exit Sub
   
9.       End If
   
10.   Next rng
    
11. Sheets("登记").Range("b5:h" & i).Copy Sheets(Sheets("登记").Cells(3, 7).Value & "台账").Range("a" & j)
    
12. Sheets("登记").Range("i5:j" & i).Copy Sheets(Sheets("登记").Cells(3, 7).Value & "台账").Range("i" & j)
    
13. MsgBox "数据已成功录入到" & "《" & Sheets("登记").Cells(3, 7).Value & "台账》工作表"
    
14. Sheet1.[B5:J9] = ""
    
15. End Sub

复制代码

跳转到最佳答案楼层

810126769

在thisworkbook中写入代码：

1. Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
   
2. If 单元格1 = "" Or 单元格2 = "" Or 单元格3 = "" Or 单元格4 = "" Then
   
3. MsgBox "请输入数据"
   
4. 
   
5. End If
   
6. End Sub

复制代码

haryzbs

810126769 发表于 2014-4-3 15:37
在thisworkbook中写入代码：

加入代码后，在保存时提示“请输入数据”，但是照样把我的标题栏保存到我的录入表格中去了。

810126769

haryzbs 发表于 2014-4-3 18:51
加入代码后，在保存时提示“请输入数据”，但是照样把我的标题栏保存到我的录入表格中去了。

哦，还得这样修改：

1. Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
   
2. If 单元格1 = "" Or 单元格2 = "" Or 单元格3 = "" Or 单元格4 = "" Then
   
3. MsgBox "请输入数据"
   
4. cancel=true
   
5. End If
   
6. End Sub

复制代码

haryzbs

810126769 发表于 2014-4-3 20:39
哦，还得这样修改：

你好，我加入到我的代码中，执行的时候还是存在没有数据的时候提示，但是照样进行保存空表格。
Sub 录入()
Dim i, j
i = Sheets("登记").Cells(Rows.Count, 2).End(xlUp).Row
j = Sheets(Sheets("登记").Cells(3, 7).Value & "台账").Cells(Rows.Count, 1).End(xlUp).Row + 1
If B5= "" Or C5 = "" Or D5= "" Or E5 = "" F5 = "" H5 = "" I5 = "" J5 = "" Then
MsgBox "请输入对应空白项数据之后再保存"
cancel=true
End If
Sheets("登记").Range("b5:h" & i).Copy Sheets(Sheets("登记").Cells(3, 7).Value & "台账").Range("a" & j)
Sheets("登记").Range("i5:j" & i).Copy Sheets(Sheets("登记").Cells(3, 7).Value & "台账").Range("i" & j)
MsgBox "数据已成功录入到" & "《" & Sheets("登记").Cells(3, 7).Value & "台账》工作表"
   [B5:J9] = ""
End Sub
能不能麻烦您帮我在这段代码中进行修改呢，只要有一项数据位空，则停止保存，只有当所有数据全部填完之后才能进行保存。

810126769

haryzbs 发表于 2014-4-3 23:49
你好，我加入到我的代码中，执行的时候还是存在没有数据的时候提示，但是照样进行保存空表格。
Sub 录 ...

能不能传一个附件上来？

haryzbs

810126769 发表于 2014-4-4 07:19
能不能传一个附件上来？

您好，附件已经上传，我就是在第一个登记表格中，如果一个信息没有登记的话，选择就要保存4行的所有文字到对应的表格中，选择我是需要如果从5行开始没有输入数据，只要点击保存则做出相应的错误提醒。
考勤-员工请销假电子台账.zip (276.28 KB, 下载次数: 5)

2014-4-4 08:39 上传

点击文件名下载附件

810126769

haryzbs 发表于 2014-4-4 08:39
您好，附件已经上传，我就是在第一个登记表格中，如果一个信息没有登记的话，选择就要保存4行的所有文字到 ...

看了好久，好象现在猜出你的要求了：
请测试，看是不是要这样的效果：
考勤-员工请销假电子台账.rar (139.73 KB, 下载次数: 38)

2014-4-4 09:18 上传

点击文件名下载附件

1. Sub 录入()
   
2. Dim i, j, rng As Range
   
3. i = Sheets("登记").Cells(Rows.Count, 2).End(xlUp).Row
   
4. j = Sheets(Sheets("登记").Cells(3, 7).Value & "台账").Cells(Rows.Count, 1).End(xlUp).Row + 1
   
5.   For Each rng In Sheet1.Range("b5:j9")
   
6.       If rng = "" Then
   
7.          MsgBox "请输入对应空白项数据之后再保存"
   
8.          Exit Sub
   
9.       End If
   
10.   Next rng
    
11. Sheets("登记").Range("b5:h" & i).Copy Sheets(Sheets("登记").Cells(3, 7).Value & "台账").Range("a" & j)
    
12. Sheets("登记").Range("i5:j" & i).Copy Sheets(Sheets("登记").Cells(3, 7).Value & "台账").Range("i" & j)
    
13. MsgBox "数据已成功录入到" & "《" & Sheets("登记").Cells(3, 7).Value & "台账》工作表"
    
14. Sheet1.[B5:J9] = ""
    
15. End Sub

复制代码

haryzbs

810126769 发表于 2014-4-4 09:18
看了好久，好象现在猜出你的要求了：
请测试，看是不是要这样的效果：

就是这样的，，谢谢您。。