【问题标题】:Determine if cell is not empty, to select a dynamic range确定单元格是否不为空,以选择动态范围
【发布时间】:2021-09-03 10:37:50
【问题描述】:

我正在尝试使用 For/If/Else 根据某个单元格是否不为空来返回各种范围,然后将该范围粘贴到电子邮件中。

下面的代码返回范围 B15:G20,无论有问题的单元格 (b20) 是否为空。理想情况下,我想测试最多四个单元格,看看它们是否不为空,并返回一个仅包含包含数据的单元格的范围。

Sub EXPVendorCopyRangeToOutlook_single()
    'Declare Outlook Vairables
    Dim oLookApp As Outlook.Application
    Dim oLookItm As Outlook.MailItem
    Dim oLookIns As Outlook.Inspector
    
    'Declare Word Vaiables
    Dim oWrdDoc As Word.Document
    Dim oWrdRng As Word.Range
    
    'Declare Excel Variables
    Dim ExcRng As Range
    
    On Error Resume Next
    'Get the Active instance of Outlook
    Set oLookApp = GetObject(, "Outlook.Application")
    
    'If error create a new instance of outlook
    If Err.Number = 429 Then
        'Clear Error
        Err.Clear
        
        'Create new instance of Outlook
        Set oLookApp = New Outlook.Application
        
    End If
    'Create a new email 'Possible Problem here
    Set oLookItm = oLookApp.CreateItem(olMailItem)
    'Create a reference to the ex range you want to export
    
    For Each Cell In Worksheets("sheet1")
        If Not IsEmpty(b20.Value) Then
            Set ExcRng = Sheet1.Range("b15:g20")
        ElseIf Not IsEmpty(b19.Value) Then
            Set ExcRng = Sheet1.Range("b15:g18")
        End If
    Next
        
    With oLookItm
    
        'Define basic info
        .From = "ABC@XYZ.COM"
        
        .To = "123@345.COM"
        .CC = ""
        .Subject = Range("m3")
        
        .Body = "Please review the attached invoices and confirm that the goods or services have been received and payment should be made."
        
        'Display email
        .Display
        'Get the active inspector
        Set oLookIns = .GetInspector
        
        'Get word editor
        Set oWrdDoc = oLookIns.WordEditor
        
        'Specify rang in document
        Set oWrdRng = oWrdDoc.Application.ActiveDocument.Content
            oWrdRng.Collapse Direction:=wdCollapseEnd
        
        'Add new paragraphand then insert break
        Set oWrdRng = oWdEditor.Paragraph.Add
            oWrdRng.InsertBreak
        
        'Copy the Range
        ExcRng.Copy
        
        'Paste it
        oWrdRng.PasteSpecial DataType:=wdPasteMetafilePicture
    End With
End Sub

这是给我带来问题的代码部分。

For Each Cell In Worksheets("sheet1")
    If Not IsEmpty(b20.Value) Then
        Set ExcRng = Sheet1.Range("b15:g20")
    ElseIf Not IsEmpty(b19.Value) Then
        Set ExcRng = Sheet1.Range("b15:g18")
    End If
Next

【问题讨论】:

  • 您缺少 Range 参考。试试 IsEmpty(Range(B20).Value) 看看效果是否更好。
  • On Error Resume Next 应在设置 Outlook 应用程序对象后使用 On Error Goto 0 取消。否则,您的代码会愉快地跳过任何错误而不标记它们。
  • 我将代码更新为 For Each Cell In Worksheets("sheet1") If Not IsEmpty(Range(b20).Value) Then Set ExcRng = Sheet1.Range("b15:g20") ElseIf Not IsEmpty (Range(b19).Value) Then Set ExcRng = Sheet1.Range("b15:g18") End 如果它粘贴了之前所做的范围,即使在上述建议之后,它也不会基于空进行更改细胞。
  • b20.Value 的语法是否有效?试试Range("B20").Value,同样的B19?另外,我几乎肯定你不想检查工作表中的每个单元格?你为什么要循环,你一遍又一遍地检查同一个单元格的值......
  • 我不确定语法,VBA 不是我的强项。但它可以按原样设置我想要过去的范围。它会过去的东西。它只是不是动态的。我不想检查每个单元格,我有一个范围要在那里检查,我把它拿出来测试一些东西,忘了把它放回去。

标签: excel vba if-statement


【解决方案1】:

好了,我有一些语法错误 `对于工作表中的每个单元格("sheet10").Range("b20:g25") If Not IsEmpty(Sheet10.Range("b25").Value) 那么 设置 ExcRng = Sheet10.Range("b20:g25") ElseIf Not IsEmpty(Sheet10.Range("b24").Value) Then 设置 ExcRng = Sheet10.Range("b20:g24") ElseIf Not IsEmpty(Sheet10.Range("b23").Value) Then 设置 ExcRng = Sheet10.Range("b20:g23") ElseIf Not IsEmpty(Sheet10.Range("b22").Value) Then 设置 ExcRng = Sheet10.Range("b20:g22") 万一 下一个

【讨论】:

    猜你喜欢
    • 1970-01-01
    • 2012-08-17
    • 2018-10-12
    • 1970-01-01
    • 2014-01-16
    • 1970-01-01
    • 2018-03-06
    • 2019-03-27
    • 2023-03-30
    相关资源
    最近更新 更多