Excel VBA 查找下一个单元格（如果其为空则添加文本）

Question

我有一张带有许多按钮的工作表，如果字段中有日期，我希望它转到下一行，如果没有，我需要它返回 N/A 或 0.00。如果我只对一个单元格执行此操作，我的代码就可以工作，但如果我尝试添加另一个单元格，它要么不会返回 n/a，要么会添加 n/a 和我想要复制的单元格中的数据（这是针对 c2 数据）

Sub Button55_Click()
Dim M As Worksheet
    Set MM = ThisWorkbook.Worksheets("Dialer")
            If MM.Range("A2").Value = "" Then Response = MsgBox("Member Number is Blank", vbOKOnly + vbCritical)
                      If Response = vbOK Then Exit Sub
Dim K As Worksheet
    Set KK = ThisWorkbook.Worksheets("Dialer")
            If KK.Range("B2").Value = "" Then Response = MsgBox("Balance Cured is Blank do you Wish to Continue?", vbYesNo + vbCritical)
                      If Response = vbNo Then Exit Sub
                      If Response = vbYes Then
                         
        Dim C As Range
        Set C = Worksheets("Worksheet").Cells(Rows.Count, 4).End(xlUp)
        If Len(C.Value) > 0 Then Set C = C.Offset(1)
        
        Dim P As Range
        Set P = Worksheets("Worksheet").Cells(Rows.Count, 5).End(xlUp)
        If Len(P.Value) > 0 Then Set P = P.Offset(1)
        P.Value = "N/A"
        End If
 
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets("Worksheet")
    
    Dim NextFreeCell As Range 'Range(C)'
    Set NextFreeCell = ws.Cells(ws.Rows.Count, "C").End(xlUp).Offset(RowOffset:=1)
    
        NextFreeCell.Value = "Deceased"
    Dim R As Range
        Set R = Worksheets("Worksheet").Cells(Rows.Count, 1).End(xlUp)
        If Len(R.Value) > 0 Then Set R = R.Offset(1)
        R.Value = Worksheets("Dialer").Range("a2").Value
        
    Dim B As Range
        Set B = Worksheets("Worksheet").Cells(Rows.Count, 4).End(xlUp)
        If Len(B.Value) > 0 Then Set B = B.Offset(1)
        B.Value = Worksheets("Dialer").Range("B2").Value
        
    Dim X As Range
        Set X = Worksheets("Worksheet").Cells(Rows.Count, 2).End(xlUp)
        If Len(X.Value) > 0 Then Set X = X.Offset(1)
        X.Value = Date
        
    Dim J As Range
        Set J = Worksheets("Worksheet").Cells(Rows.Count, 5).End(xlUp)
        If Len(J.Value) > 0 Then Set J = J.Offset(1)
        J.Value = Worksheets("Dialer").Range("C2").Value
        

        
    
    
    Range("A2").ClearContents
    Range("B2").ClearContents
    Range("C2").ClearContents
    
    
End Sub

Answer 1

我尝试转换你的代码。希望我正确猜出了你的目标：

Sub Button55_Click()
Rem Do not scatter variable declarations throughout the procedure code,
Rem collect them all in one place, at the beginning:
Dim wsSource As Worksheet, wsTarget As Worksheet
Dim rSourceRange As Range
Dim aSourceData As Variant, aResultData(0, 4) As Variant
Dim lastNonEmptyCell As Range
Dim FirstEmptyRow As Long

Rem Variable values that will not change later, calculate immediately
Rem and then just use (don't calculate it every time)
    Set wsSource = ThisWorkbook.Worksheets("Dialer")
    Set wsTarget = ThisWorkbook.Worksheets("Worksheet")
    Set rSourceRange = wsSource.Range("A2:C2")
    aSourceData = rSourceRange.Value
    
Rem Populate the array of results sequentially, element by element -
Rem jumps 4, 5, then 3, 1, 2, and again 4 and 5 makes the code very difficult to read!
    aResultData(0, 0) = aSourceData(1, 1)
    If IsEmpty(aSourceData(1, 1)) Then
Rem If vbOKOnly is used in MSGBOX(), then it is useless to check whether the function will return vbOK
        Call MsgBox("Member Number is Blank", vbOKOnly + vbCritical)
        Exit Sub
    End If
    
    aResultData(0, 1) = Date
    aResultData(0, 2) = "Deceased"
    aResultData(0, 3) = aSourceData(1, 2)
    If IsEmpty(aSourceData(1, 2)) Then
        If MsgBox("Balance Cured is Blank do you Wish to Continue?", vbYesNo + vbCritical) = vbNo Then
            Exit Sub
        Else
            aResultData(0, 3) = "N/A"
        End If
    End If
    aResultData(0, 4) = aSourceData(1, 3)
    If IsEmpty(aSourceData(1, 3)) Then aResultData(0, 4) = "N/A"
Rem .End(xlUp) is a good way to find the last cell in one column.
Rem But if you are looking for the last ROW on the sheet, then it is better to use another way:
    Set lastNonEmptyCell = wsTarget.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious)
    If lastNonEmptyCell Is Nothing Then
        FirstEmptyRow = 1
    Else
        FirstEmptyRow = lastNonEmptyCell.Row + 1
    End If
Rem Try not to read and write cells one at a time,
Rem read and write in whole ranges - this is much more efficient:
    wsTarget.Range("A" & FirstEmptyRow & ":E" & FirstEmptyRow).Value2 = aResultData
Rem For dates to display correctly, set the cell to the correct date format:
    wsTarget.Range("B" & FirstEmptyRow).NumberFormat = "yyyy-mm-dd"
Rem And clear the whole range in one go:
    rSourceRange.ClearContents
End Sub