0

以下は私がこれまで持っているコードです：

Sub Compare()

Sheets("SCR SYSTEM SPECS").Select
Sheets("SCR SYSTEM SPECS").Copy
Dim WS As Excel.Worksheet
Dim ColumnCount As Long
Dim I As Long
Dim Cell As Excel.Range

Set WS = ActiveSheet    'adjust as necessary
ColumnCount = 12    'adjust as necessary
With WS
For I = ColumnCount To 1 Step -1
    Set Cell = .Cells(3, I)
    If Cell.Value = False Then
        Cell.EntireColumn.Delete
    End If
Next I
End With

ActiveSheet.Shapes.Range(Array("Button 1", "Check Box 1", "Check Box 2", _
    "Check Box 3", "Check Box 4", "Check Box 5", "Check Box 6", "Check Box 7", _
    "Check Box 8", "Check Box 9", "Check Box 10", "Check Box 11")).Select
Selection.Delete

End Sub

私が必要とするのは、範囲 B4:L4 をループし、各セルをチェックして X で終わるかどうかを確認するために、このすべての下に移動するマクロです。この行には、次の数字/テキストの任意の組み合わせが含まれます: 1300、2000、2000X、2500、2500X、3000、3000X、4500、6000、7000、9000。特定の行を削除します。If Not Like "*X" を使用しようとして失敗しました。以下は、これまでに試したが失敗したコードです。どんな助けでも大歓迎です。

Dim MyCell, Rng As Range
Set Rng = Sheets("SCR SYSTEM SPECS").Range("B4:L4")
For Each MyCell In Rng
    If Not MyCell Like "*X" Then '''''will only do something if the cell is not blank
    Rows("4:18").Select
    Selection.EntireRow.Hidden = True
    'Else '''''if cell is equal to blank
    'Rows("4:18").Select
    'Selection.EntireRow.Hidden = False
    End If
Next

これは、すべて 0 を含む行を非表示にするために使用しようとしている変更されたコードですが、すべて 0 を含む行、または 0 を含む 2 つの列と 4 を含む列を含む行を非表示にしています。アドバイスしてください。

Dim MyCell2, Rng2 As Range
Set Rng2 = Sheets("SCR SYSTEM SPECS").Range("B36:L36")
For Each MyCell2 In Rng2
    If Right(Trim(MyCell2.Value), 1) = "0" Then
    Range("36:36").Select
    Selection.EntireRow.Hidden = True
    End If
Next
4

1 に答える 1

2

LIKE関数はトリッキーで、とにかくあいまいなので、おそらくあなたが望むものではありません.

RIGHT関数を使用します。

Sub TestThis()
Dim MyCell, Rng As Range
Set Rng = Sheets("SCR SYSTEM SPECS").Range("B4:L4")
For Each MyCell In Rng
    If Right(Trim(MyCell.Value),1) = "X" Then '''''will only do something if the cell is not blank
        Rows("4:18").EntireRow.Hidden = True
        'Else '''''if cell is equal to blank
        'Rows("4:18").EntireRow.Hidden = False
    End If
Next
End Sub

また、上記のコードを回避するように修正しますがSelection、これは約 99% の確率で不要です。

「これらのセルのいずれにも含まれていない場合...」を探しているのでExit、条件が満たされたら、ループに次の追加の改訂をお勧めします。

Sub TestThis()
Dim MyCell, Rng As Range
Set Rng = Sheets("SCR SYSTEM SPECS").Range("B4:L4")
For Each MyCell In Rng
    If Right(Trim(MyCell.Value),1) = "X" Then '''''will only do something if the cell is not blank
        Rows("4:18").EntireRow.Hidden = True
        Exit For '## Exit the loop once the condition is met ##'
        'Else '''''if cell is equal to blank
        'Rows("4:18").EntireRow.Hidden = False
    End If
Next
End Sub
于 2013-05-15T14:06:32.567 に答える