即使不满足所有条件，Excel VBA 也会运行所有 If 语句

Question

我的工作表有一个包含许多列的表格，但只有前两列是输入字段，其余列的公式基于前两列中的值。我没有在前几列中手动输入信息，而是在表格之外设置了两个输入字段，一旦单击了带有分配宏的按钮，就可以将其传输到表格中。

我编写的 VBA 代码有几个 If-Then 语句。如果第一个输入字段 (B3) 为空白，则第一个语句返回一个 msgbox。如果第二个输入字段 (B4) 为空白，则第二个语句返回一个 msgbox。如果 B3 和 B4 不为空，则第三条 If-Then 语句会将 B3 和 B4 中的信息传输到下一个可用表行。

如果我在 B3 和 B4 中输入信息，代码可以正常工作。当 B3 和 B4 为空白时，问题就出现了——我收到了适当的 msgbox，但空白信息仍然作为新行添加到表中。如果我在 B3 和 B4 中没有信息时单击我的按钮，它将继续给我 msgbox，同时还会向我的表中添加行。我做错了什么？

Sub AddToPortfolio()

Dim portfolio As Worksheet
Dim table_list_object As ListObject
Dim table_object_row As ListRow

Set portfolio = Sheets("Sheet1")
Set table_list_object = portfolio.ListObjects(1)
Set table_object_row = table_list_object.ListRows.Add

  If portfolio.Range("B3").Value = Empty Then
        MsgBox "Please Enter CUSIP ID"
     portfolio.Range("B3").Select
    Exit Sub
  End If

  If portfolio.Range("B4").Value = Empty Then
        MsgBox "Please Enter Quantity"
     portfolio.Range("B4").Select
  End If

  If portfolio.Range("B3").Value <> "" And portfolio.Range("B4").Value <> "" Then
     table_object_row.Range(1, 1).Value = portfolio.Range("B3").Value
     table_object_row.Range(1, 2).Value = portfolio.Range("B4").Value
  End If


End Sub

Answer 1

写入表中的新行

守则

Option Explicit

Sub AddToPortfolio()

    Dim wb As Workbook: Set wb = ThisWorkbook
    Dim ws As Worksheet: Set ws = wb.Worksheets("Sheet1")
    Dim Cell1 As Range: Set Cell1 = ws.Range("B3")
    Dim Cell2 As Range: Set Cell2 = ws.Range("B4")

    If checkEmpty(Cell1, "Please Enter CUSIP ID") Then Exit Sub
    If checkEmpty(Cell2, "Please Enter Quantity") Then Exit Sub

    Dim tbl As ListObject: Set tbl = ws.ListObjects(1)
    Dim tblRow As ListRow: Set tblRow = tbl.ListRows.Add
    tblRow.Range(1, 1).Value = Cell1.Value
    tblRow.Range(1, 2).Value = Cell2.Value
    ' To avoid duplicates:
    Union(Cell1, Cell2).ClearContents

End Sub

Function checkEmpty(SourceCell As Range, ByVal Message As String) As Boolean
    If SourceCell.Value = Empty Then
        checkEmpty = True
        SourceCell.Select
        MsgBox Message
    End If
End Function

Answer 2

 Set table_list_object = portfolio.ListObjects(1)
  Set table_object_row = table_list_object.ListRows.Add

您能否尝试将这两行移到最后一个 IF 语句中？此外，还要在第二个 if 语句中添加一个“Exit Sub”。