Excel VBA中选择性列的偏移功能

Question

VBA新增功能。尽管这似乎很简单，我无法弄清楚如何使用偏移功能和While/Do while循环这里。

我正在制作一个Excel表格，其中列A到L将具有值。

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

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

我的excel如下所示。

我已经写了代码，它检查强制列是否有价值观没有。

的代码如下：

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列的值，那么只有上面的代码应该exceuted”

我试图实现它，因为我已经写在下面的代码。但是，我不是最高的。

我评论的代码是给我的错误（从下面的代码）所有这些行：

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 

有人能指导我怎样才能让它正确使用补偿功能的/而在这里循环？

编辑：

假设，XYZ学校没有价值号教师

而且

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

我电流输出是如下图：

凡为期望输出是：

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