Excel清理代码VBA

时间:2012-12-04 14:05:21

标签: excel excel-vba excel-2007 vba

我有一些效果很好的代码,但我知道它可以写得比我的更清晰。

Sub DeleteField()
Range("A6").Select

        Do
            If ActiveCell.Value = "Actual Conveyable Cases" Or _
            ActiveCell.Value = "Projected Non Con" Or _
            ActiveCell.Value = "Actual Non Con Cases" Or _
            ActiveCell.Value = "Projected CPT" Or _
            ActiveCell.Value = "Actual CPT" Or _
            ActiveCell.Value = "Projected Store Loads" Or _
            ActiveCell.Value = "Actual Store Loads" Or _
            ActiveCell.Value = "Projected Pull Ahead" Or _
            ActiveCell.Value = "Actual Pull Ahead" Or _
            ActiveCell.Value = "Projected Loads at 08:00" Or _
            ActiveCell.Value = "Actual Loads at 08:00" Then
        ActiveCell.EntireRow.Select
        Selection.Delete
        ActiveCell.Select
            Else: ActiveCell.Offset(1, 0).Select
        End If

    Loop Until ActiveCell.Value = "" And ActiveCell.Offset(-5, 0).Value = ""

MsgBox "Done!"

End Sub

我正在寻找一种方法来清理多个Or语句。有没有办法可以通过数组或者某种方式来清理所有的“ActiveCell”段

4 个答案:

答案 0 :(得分:5)

您可以使用SELECT CASE statement来清理它:

Select Case ActiveCell.Value 
    Case "Actual Conveyable Cases", "Projected Non Con", _
         "Actual Non Con Cases", "Projected CPT", "etc..."

            ActiveCell.EntireRow.Select
            Selection.Delete
            ActiveCell.Select

    Case Else

            ActiveCell.Offset(1, 0).Select

End Select

答案 1 :(得分:1)

这就是我如何编程来清理它。希望它有所帮助。

另外,我删除了条件: ActiveCell.Offset(-5,0).Value =“”

因为向下移动5个额外的细胞似乎很奇怪

Option Explicit

Public Sub DeleteField()
    Dim sh As Excel.Worksheet
    Dim iLastRow As Long, iFirstRow As Long, i As Long

    ' define the array here so we don't have to create it over
    ' and over again in the function toDelete()
    Dim list(11) As String
    list(0) = "Actual Conveyable Cases"
    list(1) = "Projected Non Con"
    list(2) = "Actual Non Con Cases"
    list(3) = "Projected CPT"
    list(4) = "Actual CPT"
    list(5) = "Projected Store Loads"
    list(6) = "Actual Store Loads"
    list(7) = "Projected Pull Ahead"
    list(8) = "Actual Pull Ahead"
    list(9) = "Projected Loads at 08:00"
    list(10) = "Actual Loads at 08:00"

    Set sh = ActiveSheet
    iFirstRow = 6
    iLastRow = sh.Cells(sh.Rows.Count, 1).End(xlUp).Row

    ' loop through the cells from bottom to top (because if we
    ' delete the row it's easier to maintain where we are)
    For i = iLastRow To iFirstRow Step -1
        If (toDelete(list, sh.Cells(i, 1))) Then
            sh.Cells(i, 1).EntireRow.Delete
        End If
    Next

    MsgBox "Done!"
End Sub

Private Function toDelete(ByRef list() As String, ByRef r As Excel.Range) As Boolean
    Dim i As Long
    For i = 0 To UBound(list)
        If (r.Value = list(i)) Then
            toDelete = True
            Exit Function
        End If
    Next i

    toDelete = False
End Function

答案 2 :(得分:1)

查看问题,可以使用

完成与多个值的匹配
Dim value As String
Dim matched As Boolean
Dim criteria As String

'** Put all possible strings separated by comma here
criteria = "Actual Conveyable Cases, Projected Non Con, Actual Non Con Cases"

do
   matched = (InStr(1, criteria, ActiveCell.Value) <> 0)

   If matched then

   End If
...

InStr函数将起作用,因为您的条件字符串不会包含在另一个字符串中。

即。如果

,上述内容将无效
criteria = "Actual Conveyable Cases, Actual Conveyable Cases 1, Actual Conveyable Cases 2"

答案 3 :(得分:0)

我知道你有很好的答案,但作为Dictionary对象的推销员,我有义务展示在这里使用它的乐趣。它也可以超快速地工作,所以如果您有很长的条件列表,这可能是您想要的方式。享受!

Sub DeleteField()

Dim dict As Object, i As Long
Set dict = CreateObject("scripting.dictionary")

dict.Add "Actual Conveyable Cases", 1
dict.Add "Projected Non Con", 1
dict.Add "Actual Non Con Cases", 1
dict.Add "Projected CPT", 1
dict.Add "Actual CPT", 1
dict.Add "Projected Store Loads", 1
dict.Add "Actual Store Loads", 1
dict.Add "Projected Pull Ahead", 1
dict.Add "Actual Pull Ahead", 1
dict.Add "Projected Loads at 08:00", 1
dict.Add "Actual Loads at 08:00", 1

For i = range("A" & Rows.count).End(xlUp).Row To 1 Step -1
    If dict.exists(range("A" & i).Value) Then
        Rows(i).Delete
        i = i + 1
    End If
Next

MsgBox "Done!"

End Sub