尝试运行代码复制数据并发送电子邮件后,Excel没有响应

基本上我有7个单元格可以填充文本(b2,b4,b6,b8,b10,b12和b14)。 我想要代码来检查每个单元格,以查看它们是否有值,并只发送在电子邮件中具有值的单元格。 为了进行格式化,粘贴到电子邮件中的单元格之间需要有一个空单元格,并且单元格需要按原来的顺序保存,而不需要不必要的空单元格。

我从来没有正式学过VBA,我只是一个一个的情况下教我自己,所以可能有一个简单的解决scheme,我错过了。 通常我可以debugging和发现问题,但在这种情况下,Excel完全冻结并变成“不响应”。 我有一种感觉,这意味着我有一个循环未解决的地方,但我真的不明白如何。 代码 – 运行到Range(“A2”)。Value = Line(LineCount1)。 任何build议,将不胜感激。

Public Sub SingleEmail() Dim LineCount1 As Integer Dim LineCount2 As Integer Dim LineCount3 As Integer Dim LineCount4 As Integer Dim LineCount5 As Integer Dim LineCount6 As Integer Dim LineCount7 As Integer Dim NumOfLines As Integer Range("A2", "A14").ClearContents LineCount1 = 2 Range("A2").Value = Line(LineCount1) LineCount2 = 2 + LineCount1 Range("A4").Value = Line(LineCount2) LineCount3 = 2 + LineCount2 Range("A6").Value = Line(LineCount3) LineCount4 = 2 + LineCount3 Range("A8").Value = Line(LineCount4) LineCount5 = 2 + LineCount4 Range("A10").Value = Line(LineCount5) LineCount6 = 2 + LineCount5 Range("A12").Value = Line(LineCount6) LineCount7 = 2 + LineCount6 Range("A14").Value = Line(LineCount7) NumOfLines = Range("n3").Value If Range("A2") <> "" Then Range("A2", "A" & NumOfLines).Select ActiveWorkbook.EnvelopeVisible = True With ActiveSheet.MailEnvelope .Introduction = "" .Item.To = "personalemailaddress@Someplace.com" .Item.CC = "" .Item.Subject = "Email Subject" .Item.send End With End If End Sub Function Line(ByRef LineCount As Integer) As String Line = "" Do While Line = "" Or LineCount < 13 If Range("B" & LineCount).Value <> "" Then Line = Range("B" & LineCount).Value Else LineCount = LineCount + 2 End If Loop End Function 

回答你的问题:

如果B4有值, B2是空白的,那么这个While循环变成无限的。 LineCount被卡住了4,因此没有溢出。 这就是为什么你的代码冻结。

为什么你首先运行一个循环。 你可以简单的赋值Range("A2:A14").Value =Range("B2:B14").Value根据你的评论,你需要使用And操作符来代替OR Do While Line = "" And LineCount < 13如果Line <>“”或LineCount> 14 Do While Line = "" And LineCount < 13现在将退出循环