0

こんにちは、

次の項目についてサポートが必要です。

入力に基づいて自動ソートと自動色の両方を行うマクロを見つけようとしています。

たとえば、3 つの列があります。最初の列に、目的の遺伝子の遺伝子型を入力します。同じ Excel で VLOOKUP シートを使用すると、エントリはその遺伝子の同等の表現型を 2 列目に返します。最後の列である 3 番目の列は、この表現型が疾患の状態にどのように影響するかを返します (例: 正常 = 緑、遅い = 黄色、速い = 赤)。

元のスプレッドシートは次のように表示されます。

Genotype    Phenotype    Disease State 
XX          IM           Slow
YY          UM           Fast
XY          EM           Normal
YY          UM           Fast

自動色付けと自動並べ替えがタスクを完了すると、この表は次のようになります。

Genotype    Phenotype    Disease State
XY          EM           Normal
XX          IM           Slow
YY          UM           Fast
YY          UM           Fast

自動ソートまたは自動色のみのマクロを見つけましたが、これらのマクロを組み合わせようとすると、エラーが発生し続けます。

どんな助けでも大歓迎です！

これらは私が試したマクロです。自動並べ替えは完全に機能しますが、自動色付けに問題があります。私が得るエラーは範囲であり、時には何も起こりません。

自動ソートの場合:

Private Sub Worksheet_Change(ByVal Target As Range)
    On Error Resume Next
    If Not Intersect(Target, Range("A:A")) Is Nothing Then
        Range("A1").Sort Key1:=Range("A2"), _
          Order1:=xlDescending, Header:=xlYes, _
          OrderCustom:=1, MatchCase:=False, _
          Orientation:=xlTopToBottom
    End If
End Sub

自動着色の場合:

Sub Worksheet_Change(ByVal Target As Range)
If Target.Column <> 1 Then Exit Sub
If Target.Row < 1 Then Exit Sub
Select Case LCase(Target.Value)
    Case "Normal"
        Target.EntireRow.Interior.ColorIndex = 3
    Case "Fast"
        Target.EntireRow.Interior.ColorIndex = 4
    Case "Slow"
        Target.EntireRow.Interior.ColorIndex = 5
        Target.EntireRow.Interior.ColorIndex = xlColorIndexAutomatic
End Select
Application.EnableEvents = True
End Sub

Sub changeApplicationEnableEvents2truee()
Application.EnableEvents = True
End Sub
4

2 に答える 2

0

@pnuts が言ったように、1 つの問題は、2 つの Worksheet_Change ルーチンがあるように見えることです。色を変更するコードにはいくつかの問題がありました。LCase() を使用すると、文字列値がすべて小文字になります。再ソートされた範囲全体ではなく、変更された行のみが色を変更していました。等

私はあなたが持っていたものにいくつかの最小限の変更を加えました. これにより、探している結果が得られますか?

Private Sub Worksheet_Change(ByVal Target As Range)

Dim rng As Range


    On Error Resume Next
    If Not Intersect(Target, Range("A:A")) Is Nothing Then
        Range("A1").Sort Key1:=Range("A2"), _
          Order1:=xlDescending, Header:=xlYes, _
          OrderCustom:=1, MatchCase:=False, _
          Orientation:=xlTopToBottom

        For Each rng In Intersect(ActiveSheet.UsedRange, Range("A:A")).Cells

            If Not IsEmpty(rng) Then

                Select Case rng.Offset(, 2).Value
                Case "Normal"
                    rng.EntireRow.Interior.Color = vbGreen
                Case "Fast"
                    rng.EntireRow.Interior.Color = vbRed
                Case "Slow"
                    rng.EntireRow.Interior.Color = vbYellow
                Case Else
                    rng.EntireRow.Interior.ColorIndex = xlColorIndexNone
                End Select
            End If
        Next rng
    End If

End Sub
于 2013-10-01T21:16:00.970 に答える