| |
▼kanabun さん：
お世話になっております。
先ほどすこしためしてみました。文字数に関しては問題なくクリアできました。
しかし、別シートに存在するデータが複数ある場合、すべて大文字にはなるものの一番上にかかれているものだけが色が変わり、データが3個程度の場合はいろがかわるのですが10個程度になると色は変わらないといった事象がおきました。
ですので、新しく作っていただいたマクロを利用して色付けの部分を省いて、別シートにある配列を大文字にしてから、前回作っていただいたものマクロを利用して色付けを行う（色付けに関しては文字数に関係ないようだったので）といった2段構えで行うと、私が行いたかったことを達成できることがわかりました。
Sub 一塩基ゆらぎF()
Dim c As Range
Dim What
' '別シートの検索文字列リストを変数 What に取得
What = Application.Transpose( _
Worksheets("一塩基ゆらぎF").UsedRange.Resize(, 1))
If Not IsArray(What) Then What = Split(What, "")
'対象範囲を順にLoopして セルごと処理
For Each c In Worksheets("クローンリスト").UsedRange.Resize(, 1)
LargeChar c, What
Next
End Sub
Sub 完全一致F()
Dim c As Range
Dim What
' '別シートの検索文字列リストを変数 What に取得
What = Application.Transpose( _
Worksheets("完全一致F").UsedRange.Resize(, 1))
If Not IsArray(What) Then What = Split(What, "")
'対象範囲を順にLoopして セルごと処理
For Each c In Worksheets("クローンリスト").UsedRange.Resize(, 1)
LargeChar c, What
Next
End Sub
'c: 対象セル What：検索文字列
Sub LargeChar(c As Range, What As Variant)
Dim j As Long
Dim sL As String
Dim ss As String
Dim wh
For Each wh In What
sL = UCase$(wh) '例. wh:"aaa" sL:"AAA"
ss = Replace(c.Text, wh, sL) '文字列の置換
c.Value = ss '変換後の文字列をセルにセット
Do
j = InStr(j + 1, ss, sL)
If j = 0 Then Exit Do
c.Characters(j, Len(sL)).Font.Color = nColor
Loop
Next
End Sub
Sub 色づけtest()
Dim c As Range
For Each c In Selection
RepChar c, "AGGTCA", 3
RepChar c, "AGTTCA", 7
RepChar c, "ATTTCA", 22
RepChar c, "TGACCT", 5
RepChar c, "TGAACT", 8
RepChar c, "TGAAAT", 17
'c: 対象セル What：検索文字列 ColorIndex：Font色Index
Sub RepChar(ByVal c As Range, What As String, ColorIndex As Long)
Dim j As Long
Do
j = InStr(j + 1, c.Text, What)
If j = 0 Then Exit Do
With c.Characters(j, Len(What))
.Font.ColorIndex = ColorIndex ' Font色 変更
End With
Loop
End Sub
このような形にして、完全一致や、一塩基ゆらぎのマクロを動かした後に大きくなった文字を検索して色づけtestのマクロを動かすといった具合にしました。
1つのマクロですべてを対処するのは非常に難しいのだと実感いたしました。
ありがとうございました。これで仕事が非常に効率的になりました。
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
