Excel宏可從工作表復制單元格數據並根據特定條件粘貼到另一個工作表上

Question

我有兩個工作表，分別名為“ Slip”和“ Memo”。 我想從Slip復制數據並通過按Slip工作表中的命令按鈕自動將其添加到Memo。 如果“單據”中的一項（或2項）留為空白，則會出現一個消息框，提示“必須填寫所有條目”。 此后，在便箋中填寫的條目將不會添加到備注中。

到目前為止，這是我擁有的代碼：

Private Sub CommandButton1_Click()
Dim SentDate As Date, Source As String, Subject As String, ReceivedBy As 
String, Mode As String

Worksheets("Slip").Select
SentDate = Range("F11")
Source = Range("E1")
Subject = Range("E2")
ReceivedBy = Range("M34")
Mode = Range("M35")
Worksheets("Memo").Select
Worksheets("Memo").Range("A3").Select
If Worksheets("Memo").Range("A3").Offset(1, 0) <> "" Then
Worksheets("Memo").Range("A3").End(xlDown).Select

End If


ActiveCell.Offset(1, 0).Select
ActiveCell.Value = SentDate
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Source
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Subject
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = ReceivedBy
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Mode
Worksheets("Slip").Select

If IsEmpty(Range("F11")) = True And IsEmpty(Range("E1").Value) = True And 
    IsEmpty(Range("E2").Value) = True And IsEmpty(Range("M34").Value) = True
And IsEmpty(Range("M35").Value) = True  Then
  MsgBox "FORM is empty."
ElseIf IsEmpty(Range("F11")) = True Or IsEmpty(Range("E1").Value) = True 
Or IsEmpty(Range("E2").Value) = True Or IsEmpty(Range("M34").Value) = True
Or IsEmpty(Range("M35").Value) = True Then
  MsgBox "All entries must be filled."
Else
  MsgBox "Successfully added to Memo"
End If
End Sub

在消息框“必須填寫所有條目”之后，我應該設置什么條件？ ？

假設滑動看起來像這樣：

A / B / C / D / E

日期/來源/主題/接收者/方式

5月19日/ RD /會議/ HR /傳真

5月20日/ RD /會議/ HR /傳真

5月21日//會議/人力資源/傳真

單擊命令按鈕時，應該說“必須填寫所有條目”，因為我在最后一行中將“源”留為空白。 我將如何防止其余條目添加到Memo中，因此Memo應該如下所示：

A / B / C / D / E

日期/來源/主題/接收者/方式

5月19日/ RD /會議/ HR /傳真

5月20日/ RD /會議/ HR /傳真

自從我在Slip工作表中將單元格留空后，它沒有添加5月21日//會議/ HR /傳真。 條件如何？

提前致謝

Answer 1

I think the code would be like bellows,

    Sub test()
    Dim vAddress, strAddress As String
    Dim Ws As Worksheet, toWs As Worksheet

        Set Ws = Sheets("Slip")
        Set toWs = Sheets("Memo")

        vAddress = Array("f11", "e1", "q3", "e3", "m34", "m35", "f12", "a11", "c11", "g11", "h11")
        strAddress = Join(vAddress, ",")

        With Ws
            If IsEmpty(.Range("F11")) = True And IsEmpty(.Range("E1").Value) = True And _
               IsEmpty(.Range("O3").Value) = True And IsEmpty(.Range("E3").Value) = True And _
               IsEmpty(.Range("M34").Value) = True And IsEmpty(.Range("M35").Value) = True And _
               IsEmpty(.Range("F12").Value) = True And IsEmpty(.Range("A11").Value) = True And _
               IsEmpty(.Range("C11").Value) = True And IsEmpty(.Range("G11").Value) = True And _
               IsEmpty(.Range("H11").Value) = True Then
              MsgBox "FORM is empty."
            ElseIf IsEmpty(.Range("F11")) = True Or IsEmpty(.Range("E1").Value) = True Or _
                   IsEmpty(.Range("O3").Value) = True Or IsEmpty(.Range("E3").Value) = True Or _
                   IsEmpty(.Range("M34").Value) = True Or IsEmpty(.Range("M35").Value) = True Or _
                   IsEmpty(.Range("F12").Value) = True Or IsEmpty(.Range("A11").Value) = True Or _
                   IsEmpty(.Range("C11").Value) = True Or IsEmpty(.Range("G11").Value) = True Or _
                   IsEmpty(.Range("H11").Value) = True Then
              MsgBox "All entries must be filled."
            Else
                toWs.Range(strAddress).Value = .Range(strAddress).Value
              MsgBox "Successfully added to Memo"
            End If
        End With
    End Sub

可以像這樣更改代碼

   Sub test2()
    Dim vAddress, strAddress As String
    Dim Ws As Worksheet, toWs As Worksheet
    Dim rngDB As Range, n As Integer, k As Integer
        Set Ws = Sheets("Slip")
        Set toWs = Sheets("Memo")

        vAddress = Array("f11", "e1", "q3", "e3", "m34", "m35", "f12", "a11", "c11", "g11", "h11")
        strAddress = Join(vAddress, ",")
        With Ws
            Set rngDB = .Range(strAddress)
            n = rngDB.Cells.Count
            k = WorksheetFunction.CountA(rngDB)
            Select Case k
            Case 0
                MsgBox "FORM is empty."
            Case Is < n
                MsgBox "All entries must be filled."
            Case Else
                toWs.Range(strAddress).Value = .Range(strAddress).Value
              MsgBox "Successfully added to Memo"
            End Select
        End With
    End Sub