[[20110420205815]]　『倍数に色づけ』（はれ）　ページの最後に飛ぶ

『倍数に色づけ』（はれ）
すみません　　たとえばa1セルに数値がありa2の数値が　a1の倍数じゃない場合
セルの色がブルーにしたりするにはどうしたらいいでしょうか

 条件付き書式で、
 数式が で =MOD(A2,A1)<>0
 のような感じでどうでしょうか。
 (Mook)

ありがとうございます。
もっと掘り起こして尋ねさせて頂きたいのですが

例えば
A列とB列に数値があり

AとBの同じ行で B列の数値がA列の倍数じゃない場合は色をつけるというマクロかVBAできないでしょうか (はれ)

もし可能なら仕事が楽になります

 B1条件付き書式　　数式が　「=FLOOR(B1,A1)<>B1」　　書式　「色を付ける」　　(NB)

ありがとうございます
お手数かけますが例えばB列を入力後Ｂ列を選びマクロ走らせると A列の数値の倍数にきり上がるようカッコイいのはないでしょうか
求めすぎて申し訳ないです
(はれ)

 カッコイイかどうかは主観なので・・・
 シートモジュールに以下。
 A列あるいはB列に数値を入力すれば自動的に実行。

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim vA As Variant, vB As Variant
    If Target.Count = 1 Then
        If Target.Column = 1 Or Target.Column = 2 Then
            vA = Range("A" & Target.Row).Value
            vB = Range("b" & Target.Row).Value
            If IsNumeric(vA) And IsNumeric(vB) Then
                If vA <> 0 And vB <> 0 Then
                    If vB Mod vA <> 0 Then
                        Application.EnableEvents = False
                        Range("B" & Target.Row).Value = (vB \ vA + 1) * vA
                        Application.EnableEvents = True
                    End If
                End If
            End If
        End If
    End If
End Sub

↑

 ある列から複数行をコピーしてＡ列やＢ列にペーストした場合も想定すると
 以下のほうが安心なので差し替え。

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim vA As Variant, vB As Variant
    Dim c As Range
    If Target.Columns.Count = 1 Then
        If Target.Column = 1 Or Target.Column = 2 Then
            For Each c In Target
                vA = Range("A" & c.Row).Value
                vB = Range("b" & c.Row).Value
                If IsNumeric(vA) And IsNumeric(vB) Then
                    If vA <> 0 And vB <> 0 Then
                        If vB Mod vA <> 0 Then
                            Application.EnableEvents = False
                            Range("B" & c.Row).Value = (vB \ vA + 1) * vA
                            Application.EnableEvents = True
                        End If
                    End If
                End If
            Next
        End If
    End If
End Sub

ぶらっと立ち寄り

 ↑　さらに、別の複数行、複数列の領域をコピーしてＡ列、Ｂ列にかかるように
     どさっとペーストされた時も対応すると、以下。

 Private Sub Worksheet_Change(ByVal Target As Range)

    Dim vA As Variant, vB As Variant
    Dim c As Range, r As Range
    Set r = Intersect(Target, Columns("A:B"))
    If Not r Is Nothing Then
        If Target.Column = 1 Or Target.Column = 2 Then
            For Each c In r.Rows
                vA = Range("A" & c.Row).Value
                vB = Range("b" & c.Row).Value
                If IsNumeric(vA) And IsNumeric(vB) Then
                    If vA <> 0 And vB <> 0 Then
                        If vB Mod vA <> 0 Then
                            Application.EnableEvents = False
                            Range("B" & c.Row).Value = (vB \ vA + 1) * vA
                            Application.EnableEvents = True
                        End If
                    End If
                End If
            Next
        End If
        Set r = Nothing
    End If
 End Sub

 ぶらっと立ち寄り

コメント返信：

[ 一覧(最新更新順) ]

[[20110420205815]] 『倍数に色づけ』（はれ） ページの最後に飛ぶ

[[20110420205815]]　『倍数に色づけ』（はれ）　ページの最後に飛ぶ