VBA优于相关的细胞内容检查和动作故障

时间:2014-08-29 10:19:37

标签: excel vba excel-vba

任何人都可以指出我正确的方向来实现以下目标,

我有两列内容,如果其中有内容,则需要在其相邻单元格中包含内容。

        A         B     
1 | Content1 | Content2
2 | Content1 | Content2
3 | Content1 | Content2

我目前有一个工作宏

Dim ws As Worksheet
Dim currentCell As Range

Set ws = ThisWorkbook.Sheets(stMember)
Set currentCell = ws.Range("A1")

Do While Not IsEmpty(currentCell)
  Set nextCell = currentCell.Offset(0, 1)
    If IsEmpty(nextCell) Then
      Application.Goto currentCell
      MsgBox "Cell " + currentCell + " is empty"
      Exit Sub
    End If
  Set currentCell = currentCell.Offset(1, 0)
Loop

然而,A列和B列在同一行中都可以有空值,这很好,所以我需要将我的脚本更改为类似(这是描述而不是宏)

如果Col A有内容,而Col B有内容,那么

如果Col A为空,而Col B为空,则

如果Col A有内容,而Col B没有,则不行

        A         B     
1 | Content1 | Content2     OK
2 | Content1 | Content2     OK
3 | Content1 | Content2     OK
4 | Content1 | Content2     OK
5 | Content1 | Content2     OK
6 |          |              OK
7 | Content1 | Content2     OK
8 | Content1 | Content2     OK
9 | Content1 |              NOT OK
10| Content1 | Content2     OK

我不是要求实际的剧本,只是概述了实现这一目标的最佳方法。

非常感谢。

1 个答案:

答案 0 :(得分:6)

就像我在评论中提到的那样,不需要VBA代码。你可以使用

=IF(AND(B1="",A1<>""),"Not Ok","Ok")

enter image description here

如果你真的想使用VBA,那么你不需要循环:)我们将结合上面的公式和vba代码,这样我们就不必循环了。

Sub Sample()
    Dim lastrow As Long

    '~~> Change this to the relevant sheet name
    With Sheets("Sheet1")
        '~~> Find the last row in Col A/B
        If Application.WorksheetFunction.CountA(.Cells) <> 0 Then
            lastrow = .Columns("A:B").Find(What:="*", _
                          After:=.Range("A1"), _
                          Lookat:=xlPart, _
                          LookIn:=xlFormulas, _
                          SearchOrder:=xlByRows, _
                          SearchDirection:=xlPrevious, _
                          MatchCase:=False).Row
        Else
            lastrow = 1
        End If

        '~~> Enter the formula in Col C
        .Range("C1:C" & lastrow).Formula = "=IF(AND(B1="""",A1<>""""),""Not Ok"",""Ok"")"

        '~~> Convert the formula to values
        .Range("C1:C" & lastrow).Value = .Range("C1:C" & lastrow).Value
    End With
End Sub

修改

评论后续跟进。这是你在尝试什么?

Sub Sample()
    Dim lastrow As Long

    '~~> Change this to the relevant sheet name
    With Sheets("Sheet1")
        '~~> Find the last row in Col A/B
        If Application.WorksheetFunction.CountA(.Cells) <> 0 Then
            lastrow = .Columns("A:B").Find(What:="*", _
                          After:=.Range("A1"), _
                          Lookat:=xlPart, _
                          LookIn:=xlFormulas, _
                          SearchOrder:=xlByRows, _
                          SearchDirection:=xlPrevious, _
                          MatchCase:=False).Row
        Else
            lastrow = 1
        End If

        For i = 1 To lastrow
            If Len(Trim(.Range("A" & i).Value)) <> 0 And _
            Len(Trim(.Range("B" & i).Value)) = 0 Then

                '~~> Display the message and exit
                MsgBox "Cell " & .Range("B" & i).Address & " is empty"

                Exit For
            End If
        Next i
    End With
End Sub