Question

VBA新手。看起来很简单;我无法弄清楚如何使用Offset功能和While / Do while循环。

我正在创建一个excel表单，其中列A到L将具有值。

其中几列是强制性的。那些是A，B，C，D，F，G，H，I，J，L。

这意味着不能将其留空，其他列可以为空白。

我的excel看起来如下。

MyExcel

我编写了一个代码，用于检查必需列是否具有值。

代码如下：

    Dim celadr, celval As Variant
    Dim cell As Variant

    Dim LastRow As Long
    LastRow = Range("A65536").End(xlUp).Row

    On Error GoTo 0
    shname = ActiveSheet.Name

    Dim celArray, arr, Key1, KeyCell As Variant

    celArray = ("A,B,C,D,F,G,H,I,J,L")
    arr = Split(celArray, ",")
    For Key1 = LBound(arr) To UBound(arr)
    KeyCell = arr(Key1)
    Range(KeyCell & "2:" & KeyCell & "" & LastRow).Select
    'Selection.Clearformats
    For Each cell In Selection
        celadr = cell.Address
        celval = cell.Value
      If celval = "" Then
            Range(celadr).Interior.Color = vbRed
            strErr = Range(celadr).Value
            Sheets("Observations").Range("A65536").End(xlUp).Offset(1, 0).Value = IIf(strErr = "", "Empty Found", strErr)
            strstr = "'" & shname & "'!" & Range(celadr).Address(0, 0)
            Sheets("Observations").Hyperlinks.Add Anchor:=Sheets("Observations").Range("A65536").End(xlUp), Address:="", SubAddress:= _
            strstr, TextToDisplay:=IIf(strErr = "", "Empty Found", strErr)
       End If

    Next cell
    Next Key1

此代码的结果是;

1）在每两个学校记录之间，一行可以留空。我上面的代码也将在红色背景中为所有行着色。（不应该发生）

2）列B，C，D，F，G，H只能在提及school_name的同一行中具有值。因此，如果同一学校的后续行留空，那么这些行也将以红色背景着色。（不应该发生）。

因此;我想对代码做一些小修改：

我想为代码添加一个条件：

“当A列中有值时，则只应提供上述代码。”

我试图实现它，正如我在下面的代码中写的那样。不过，我还没有达成。

我已经评论了所有这些代码行，这些代码行给了我错误（来自下面的代码）：

    Dim celadr, celval, celadr1, celval1 As Variant
    Dim cell, cell1 As Variant

    Dim LastRow As Long
    LastRow = Range("A65536").End(xlUp).Row

    On Error GoTo 0
    shname = ActiveSheet.Name


    Dim celArray, arr, Key1, KeyCell As Variant
    'Range("A2:A" & LastRow).Select    
    'For Each cell1 In Selection        
        'celadr1 = cell1.Address
        'celval1 = cell1.Value
    'Do While Len(celval1) >= 1

    celArray = ("A,B,C,D,F,G,H,I,J,L")
    arr = Split(celArray, ",")
    For Key1 = LBound(arr) To UBound(arr)
    KeyCell = arr(Key1)
    Range(KeyCell & "2:" & KeyCell & "" & LastRow).Select
    'Selection.Clearformats
    For Each cell In Selection
        celadr = cell.Address
        celval = cell.Value
        ' May be another loop over here to increment value in offset function according to column number.
      If celval = "" Then 'And Offset Function Referring to column A, same row.
            Range(celadr).Interior.Color = vbRed
            strErr = Range(celadr).Value
            Sheets("Observations").Range("A65536").End(xlUp).Offset(1, 0).Value = IIf(strErr = "", "Empty Found", strErr)
            strstr = "'" & shname & "'!" & Range(celadr).Address(0, 0)
            Sheets("Observations").Hyperlinks.Add Anchor:=Sheets("Observations").Range("A65536").End(xlUp), Address:="", SubAddress:= _
            strstr, TextToDisplay:=IIf(strErr = "", "Empty Found", strErr)
       End If
    ' End If
    Next cell
    Next Key1
    ' Loop

有人可以指导我如何在这里正确使用偏移功能/ while循环吗？

修改：

假设， XYZ学校没有 No的价值。教师

和

PQRS学校没有 No的价值。学生

我的当前输出如下图所示：

My_Excel2

预期输出的位置为：

My_Excel1

Answer 1

我认为下面的代码应该可行 - 尝试一下，如果有任何问题请告诉我：

Sub Your_Macro()
    Dim celArray, item As Variant
    Dim LastRow, x As Long
    LastRow = Cells(rows.Count, "A").End(xlUp).row
    celArray = ("A,B,C,D,F,G,H,I,J,L")
    celArray = Split(celArray, ",")
    For x = 2 To LastRow
        If Not IsEmpty(Cells(x, "A")) Then
            For Each item In celArray
                If IsEmpty(Cells(x, item)) Then
                    Cells(x, item).Interior.Color = vbRed
                End If
            Next item
        End If
    Next x
End Sub

Excel VBA中选择列的偏移功能

1 个答案: