2013-06-27 17 views
1

我有防止一次更改多個單元的代碼。然而,它將允許一次刪除多個單元格。以下是我正在使用的代碼,它運行良好。引用Variant數組到列

Dim vClear As Variant 
Dim vData As Variant 

'This prevents more than one cell from being changed at once. 
'If more than one cell is changed then validation checks will not work. 
If Target.Cells.Count > 1 Then 
    vData = Target.Formula 
    For Each vClear In vData 
     If vClear <> "" Then 'If data is only deleted then more than one cell can be changed. 
      MsgBox "Change only one cell at a time", , "Too Many Changes!" 
       Application.Undo 
       Exit For 
     End If 
    Next 
End If 

我想添加到它的是當數據被刪除我希望它檢查哪些列數據被刪除。如果任何一列滿足要求,那麼我需要刪除另一列中等價行中的數據。

這是我正在嘗試做的一個例子。有兩列我需要檢查,他們是G & H.如果數據從這兩列中的任何一列中刪除,那麼我希望列I也被刪除。假設我選擇了D5:G10的範圍,並從中刪除內容。由於G列是我希望I5:I10被刪除的要求之一。如果我要刪除D5:F10,那麼它不會刪除列I中的任何內容,因爲沒有選擇G或H列。

下面是我想要做的一個示例代碼。我知道下面的代碼不可能工作,這只是我正在嘗試做的一個簡短的總結,我無法弄清楚如何讓變體也檢查列。請讓我知道,如果有人知道如何做到這一點。

Dim vClear As Variant 
Dim vData As Variant 

'This prevents more than one cell from being changed at once. 
'If more than one cell is changed then validation checks will not work. 
If Target.Cells.Count > 1 Then 
    vData = Target.Formula 
    For Each vClear In vData 
     If vClear <> "" Then 'If data is only deleted then more than one cell can be changed. 
      MsgBox "Change only one cell at a time", , "Too Many Changes!" 
       Application.Undo 
       Exit For 
     Else 
      If vClear = "" Then 
       If vClear.Column = 7 Or vClear.Column = 8 Then 
        ActiveSheet.Cells(vClear.Row, 9) = "" 
       End If 
      End If 
     End If 
    Next 
End If 

回答

1

我修改了您的代碼,以確定列G或H是否在目標中。如果是這樣,列I中的相應行也被清除。我還刪除了For循環的Else部分中不必要的If測試。

Dim vClear As Variant 
Dim vData As Variant 
Dim firstRow As Long 
Dim lastRow As Long 

'This prevents more than one cell from being changed at once. 
'If more than one cell is changed then validation checks will not work. 
If Target.Cells.Count > 1 Then 
    vData = Target.Formula 
    For Each vClear In vData 
     If vClear <> "" Then 'If data is only deleted then more than one cell can be changed. 
      MsgBox "Change only one cell at a time", , "Too Many Changes!" 
       Application.Undo 
       Exit For 
     Else 
      ' if the target includes columns G or H, we also clear column i 
      If Not Intersect(Target, Columns("G:H")) Is Nothing Then 
       ' get the first row in the target range 
       firstRow = Target.Rows(1).Row 
       ' get the last row in the target range 
       lastRow = firstRow + Target.Rows.Count - 1 
       ' clear contents of corresponding rows in column i 
       ActiveSheet.Range(Cells(firstRow, 9), Cells(lastRow, 9)).ClearContents 
      End If 
     End If 
    Next 
End If 
+0

非常好,謝謝。現在我知道Intersect,從來沒有聽說過它。代碼中的優秀語句。感謝您的幫助,它效果很好。 – Chris