Question

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

以下代码可用于重置整个工作表。您将能够在此代码中看到工作表上找到的三个不同的起始值以及每个起始值的单元格范围。有人可以帮我改变这段代码，只重置项目编号范围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

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

2 个答案: