強制列和行

Question

我需要在關閉前強制設置行和列

Private Sub Workbook_BeforeClose(Cancel As Boolean)

    Dim lr As Long
    Dim r As Long

'   Activate correct sheet
'   Sheets("Sheet1").Activate

'   Find last row in column A with data
    lr = Cells(Rows.Count, "A").End(xlUp).Row
    
'   Loop through all rows with data in column A
    For r = 2 To lr
'       Check to see if column A is not zero
        If Cells(r, "A") <> 0 Then
'           Check to see that columns B and C are not empty
            If Cells(r, "B") = "" Or Cells(r, "C") = "" Then
                Cancel = True
                MsgBox "Please fill in columns B and C", vbOKOnly, "ROW " & r & " INCOMPLETE!!!"
            End If
        End If
    Next r

End Sub

Answer 1

我使用以下方法讓它變得更快、更用戶友好：

• 用於迭代數據的數組。
• 最后是一條錯誤消息，而不是幾條。
  我還進行了請求的更改，以允許代碼與列寬要求一起工作。 只需將ColumnsToCheck = 6更改為任意多列即可。

Option Explicit

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    
    Dim lRow As Long
    Dim I As Long
    Dim ColumnsToCheck As Long
    Dim MissedItem As Boolean
    Dim Mitem As Boolean
    Dim M As Long
    Dim SrcRG As Range
    Dim SrcArr
    Dim OutMessage As String
    
    ' *** This is the number of columns you are checking INCLUDING Column A
    ColumnsToCheck = 6  'Minimum = 2

'   Find last row in column A with data
    lRow = Cells(Rows.Count, "A").End(xlUp).Row
    
    Set SrcRG = Range("A1").Resize(lRow, ColumnsToCheck)
    SrcArr = SrcRG
    MissedItem = False
    OutMessage = "Please fill in data columns 2 through " & ColumnsToCheck & "." & vbCrLf & _
                "Missing Data found in the following locations." & vbCrLf
                
    
'   Loop through all rows with data in column A
    For I = 2 To lRow
'       Check to see if column A is not zero
        If SrcArr(I, 1) <> 0 Then
'           Check to see that columns B and C are not empty
            For M = 2 To ColumnsToCheck
                Debug.Print SrcArr(I, M)
                If SrcArr(I, M) = "" Then Mitem = True
            Next M
            If Mitem = True Then
                MissedItem = True
                OutMessage = OutMessage & vbCrLf & _
                            " Missing data at row # " & I
                Mitem = False
            End If
        End If
    Next I
    
    If MissedItem = True Then
        Cancel = True
        MsgBox OutMessage, vbOKOnly, "Error: Missing Data"
    End If
    
End Sub