0
0

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?

More than 3 years have passed since last update.

エクセルシート上で、DNA配列の多重アラインメントのSNPに着色するマクロ

Last updated at Posted at 2020-04-12

はじめに

複数のDNA配列のアラインメントについて、エクセルシート上で、コンセンサス配列と異なるところに色をつけたいことってありますよね。

今回は、多重配列アラインメント(1セル 1塩基)からコンセンサス配列を求めるマクロと、多重配列アラインメントの中のコンセンサス配列と異なる塩基のセルの色を変えるマクロ、の2つを記述します。

目標とする機能

こんなデータを、
image.png

こんな風にします。

image.png

もちろん配列の数がもっと多くても、あるいはもっと長くても大丈夫なように作ります。

コンセンサス配列を作るマクロ

コンセンサス配列を求めたい多重アラインメント部分を選択した上で、マクロを実行すると、選択した各列について、1行目のセルに最も登場頻度が高かった文字を出力するようにします。一番上の行は空けておかないといけないことになります。

MacだとVBAでは辞書機能が使えないということで(衝撃)、DNA限定で作ります。

Sub コンセンサス()

Dim a As Integer
Dim c As Integer
Dim g As Integer
Dim t As Integer
Dim char As String

For Column = Selection(1).Column To Selection(Selection.Count).Column
    a = 0
    c = 0
    g = 0
    t = 0

    For Row = Selection(1).Row To Selection(Selection.Count).Row
        char = UCase(Cells(Row, Column).value)'入力が小文字の時もあるかもしれないので大文字に。
        If char = "A" Then a = a + 1
        If char = "C" Then c = c + 1
        If char = "G" Then g = g + 1
        If char = "T" Then t = t + 1
    Next Row

    If a > c And a > g And a > t Then
        Cells(1, Column) = "A"
    ElseIf c > a And c > g And c > t Then
        Cells(1, Column) = "C"
    ElseIf g > a And g > c And g > t Then
        Cells(1, Column) = "G"
    ElseIf t > a And t > c And t > g Then
        Cells(1, Column) = "T"
    Else
        Cells(1, Column) = "?"
    End If
    
Next Column
End Sub

...特に難しいところはありませんでしたね。同数の場合は?となるようになっています。これで1行目にコンセンサス配列が表示されるようになりました。
続けて、コンセンサスと異なるところに色をつけるようにします。

Sub 異なるところに色を塗る()

'コンセンサス配列を1行目に入れておく
'選択範囲の各セルについて、1行目と異なれば、背景色を赤にする。

For Row = Selection(1).Row To Selection(Selection.Count).Row
    For Column = Selection(1).Column To Selection(Selection.Count).Column
        If Cells(Row, Column).value <> Cells(1, Column).value Then
                If Cells(Row, Column).value = "A" Then
                    Cells(Row, Column).Interior.ColorIndex = 4
                ElseIf Cells(Row, Column).value = "C" Then
                    Cells(Row, Column).Interior.ColorIndex = 33
                ElseIf Cells(Row, Column).value = "G" Then
                    Cells(Row, Column).Interior.ColorIndex = 15
                ElseIf Cells(Row, Column).value = "T" Then
                    Cells(Row, Column).Interior.ColorIndex = 3
                Else
                    Cells(Row, Column).Interior.ColorIndex = 44
                End If
       End If
    Next Column
Next Row

End Sub

これでコンセンサスと異なるところに色を塗れるようになりました。

終わりに

二回マクロを実行するのが面倒なら、一度に両方やってくれるようにしても良いかもしれません。思ったものができたということで、今回はこれで終わりにしたいと思います。

0
0
1

Register as a new user and use Qiita more conveniently

  1. You get articles that match your needs
  2. You can efficiently read back useful information
  3. You can use dark theme
What you can do with signing up
0
0

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?