根据A列中的单元格值设置整个行的值？

Question

这是我要实现的目标，我在A3:A5002有一个带有项目编号的excel工作表，在B:FH列中具有与该项目有关的各种信息。 纸张的长度随着项目的中断而改变。 我的问题是工作表包含许多公式，数据验证列表以及现有的VBA代码，当从工作表中删除行时，这些代码会弄乱。 我希望创建的Sub将查看空白单元格的项目编号范围，然后将整行重置为起始值（请参见下面的代码）。 然后，我希望能够将这些空白单元格排序到工作表的底部。

下面的代码用于重置整个工作表。 您将可以在此代码中看到工作表上找到的三个不同的起始值以及每个单元格的范围。 有人可以帮助我更改此代码，以仅重置在“项目编号范围A3:A5002没有值的A3:A5002吗？

Option Explicit
Option Compare Text
Private WS          As Worksheet
Private WSRange     As Range
Private BlankRng    As Range
Private SelRng      As Range
Private TypRng      As Range

Sub ResetSheet()

'when I tried to brake the set line up using " _" to make it easier to read, it errors out.
Set BlankRng = WS.Range("A3:A5002,T3:T5002,W3:W5002,Y3:AA5002,AC3:AF5002,AI3:AM5002,AO3:AR5002,BA3:BO5002,CF3:CH5002,CK3:CK5002,CM3:CU5002,CW3:CX5002,DF3:DF5002,DU3:DU5002")
Set SelRng = WS.Range("B3:B5002,U3:V5002,AH3:AH5002,AN3:AN5002,AS3:AU5002,CI3:CJ5002,CL3:CL5002,CV3:CV5002,CY3:DE5002")
Set TypRng = WS.Range("S3:S5002")
    BlankRng.Value = ""
    SelRng.Value = " --Select--"
    TypRng.Value = "Type"
End Sub

我在想，是否有可能创建一个名为“ ResetRow”的函数，然后可以像这样使用它（下面的代码只是一个猜测）

Sub Idea()
Dim ITEM as range
Set ITEM = range("A3:A5002")
For each cell in ITEM
    If Not ActiveCell.Value = "" Then
        ActiveCell.EntireRow.ResetRow
Next Cell

Answer 1

没有For循环：

Option Explicit

Sub ResetSheet()
    Const USED_RANGE    As String = "A2:FH5002"
    Const BLANKS_COLS   As String = "A2:A5002,T2:T5002,W2:W5002,Y2:AA5002,AC2:AF5002,AI2:AM5002,AO2:AR5002,BA2:BO5002,CF2:CH5002,CK2:CK5002,CM2:CU5002,CW2:CX5002,DF2:DF5002,DU2:DU5002"
    Const SELECT_COLS   As String = "B2:B5002,U2:V5002,AH2:AH5002,AN2:AN5002,AS2:AU5002,CI2:CJ5002,CL2:CL5002,CV2:CV5002,CY2:DE5002"
    Const TYPES_COLS    As String = "S2:S5002"
    Const BLANKS_VAL    As String = vbNullString
    Const SELECTS_VAL   As String = " --Select--"
    Const TYPES_VAL     As String = "Type"

    Dim ws As Worksheet, ur As Range

    Set ws = ActiveSheet
    Set ur = ws.Range(USED_RANGE)

    Application.ScreenUpdating = False
    With ur
        .AutoFilter Field:=1, Criteria1:="="
        If .SpecialCells(xlCellTypeVisible).Count > 1 Then
            .Range(BLANKS_COLS).Value2 = BLANKS_VAL
            .Range(SELECT_COLS).Value2 = SELECTS_VAL
            .Range(TYPES_COLS).Value2 = TYPES_VAL
        End If
        .AutoFilter
    End With
    ws.Cells(5003, 1).EntireRow.Delete
    Application.ScreenUpdating = True
End Sub

Answer 2

我赞成您使用简单的ResetRow函数，因为它易于维护。 设置范围的方式可能容易出错（至少对我来说是这样），因此我的实现尝试使其变得更简单。

编辑：将工作表对象传递给重置例程可以确保目标工作表。

Option Explicit

Sub test()
    Dim ws As Worksheet
    Dim lastrow As Long
    Dim i As Long

    '--- disable updates to run much quicker
    Application.EnableEvents = False
    Application.ScreenUpdating = False

    Set ws = ActiveSheet
    lastrow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    For i = 3 To lastrow
        If ws.Cells(i, 1) = "" Then
            ResetRow ws, i
        End If
    Next i

    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

Sub ResetRow(ws As Worksheet, rowNumber As Long)
    Dim blankCols() As String
    Dim selCols() As String
    Dim typCols() As String
    Dim vc As Variant
    Dim lc As Long

    '--- initialize which columns get which setting (INCOMPLETE!! set this up correctly for your sheet)
    blankCols = Split("A,T,Y,Z,AA,AC,AD,AE,AF,AI,AJ,AK,AL,AM", ",", , vbTextCompare)
    selCols = Split("B,U,V,AH,AN,AS,CI,CJ,CL,CV", ",", , vbTextCompare)
    typCols = Split("S", ",", , vbTextCompare)

    '--- reset each field to the default setting
    For Each vc In blankCols
        lc = ws.Range(vc & 1).Column
        ws.Cells(rowNumber, lc).Value = ""
    Next vc
    For Each vc In selCols
        lc = ws.Range(vc & 1).Column
        ws.Cells(rowNumber, lc).Value = "-- Select --"
    Next vc
    For Each vc In typCols
        lc = ws.Range(vc & 1).Column
        ws.Cells(rowNumber, lc).Value = "Type"
    Next vc

End Sub