使用VBA把氨基酸单字母快速转换成三字母缩写

使用 VBA 把氨基酸单字母转换成三字母缩写 Jimmy Wang Time: 20120706 All rights reserved. Email:poster469@163.com 软件： MS word 2007 问： 1 131 VDAFLGTWKL VDSKNFDDYM KSLGVGFATR QVASMTKPTT IIEKNGDILT LKTHSTFKNT 60 EISFKLGVEF DETTADDRKV KSIVTLDGGK LVHLQKWDGQ ETTLVRELID GKLILTLTHG 120 TAVCTRTYEK E 把以上 氨基酸单字母 转换成 三字母 并输出成如下格式: Val Asp Ala Phe Leu Gly Thr Trp Lys Leu Val Asp Ser Lys Asn 5 10 15 Phe Asp Asp Tyr Met Lys Ser Leu Gly Val Gly Phe Ala Thr Arg 20 25 30 Gln Val Ala Ser Met Thr Lys Pro Thr Thr Ile Ile Glu Lys Asn 35 40 45 Gly Asp Ile Leu Thr Leu Lys Thr His Ser Thr Phe Lys Asn Thr 50 55 60 Glu Ile Ser Phe Lys Leu Gly Val Glu Phe Asp Glu Thr Thr Ala 65 70 75 Asp Asp Arg Lys Val Lys Ser Ile Val Thr Leu Asp Gly Gly Lys 80 85 90 Leu Val His Leu Gln Lys Trp Asp Gly Gln Glu Thr Thr Leu Val 95 100 105 Arg Glu Leu Ile Asp Gly Lys Leu Ile Leu Thr Leu Thr His Gly 110 115 120 Thr Ala Val Cys Thr Arg Thr Tyr Glu Lys Glu 125 130 <211> 131 解决 1： （有缺陷，只能转换 20 种氨基酸的单字母缩写） 1. 调出 VBA： word 右上角按钮>word选项>常用标签，勾选 在功能区显示开发工具。 2. 输入代码：单击 开发工具> visual basic，打开代码窗口中粘贴如下虚线行之间的附录代码 1（不含虚线）： 3. 单字母转换为三字母：光标放到 word 文档中合适位置，单击 开发工具>宏，选择 dayin_1st，运行，输入氨基 酸单字母缩写（程序遇到除字母以外的字符自动忽视，故可以含有数字），确定后得到氨基酸三字母缩写，并在 最后一行显示氨基酸个数。 此步骤也可通过网站或其他程序完成，比如 http://molbiol.ru/eng/scripts/01_17.html 4. 调整字体：氨基酸字母调为 宋体，五号字。 5. 加空格和数字：光标放到氨基酸文本第一个字母前，单击 开发工具> 宏，选择 SpaceAndNum_2nd，输入氨基 酸个数，确定后得到所需格式，保存即可。 解决方案 2：优化后的代码,合并为一个宏. （20 种氨基酸的单字母缩写之外的字母转换 Aaa三字母，并在尾部著名总数） 1. 调出 VBA： word 右上角按钮>word选项>常用标签，勾选 在功能区显示开发工具。 2. 输入代码：单击 开发工具> visual basic，打开代码窗口，新建模块，粘贴如下虚线行之间的附录代码 2（不含虚 线）： 3. 完成：把光标放到需要转换的氨基酸单字母前，单击 宏 1 。转换程序遇到第一个回车键停止。 附录代码 1： ------------------------------------------------------------------------------ Function addblank(ByVal charnum As Integer) '一行中每隔 3个字符增加一个空格，最后回车 For j = 1 To charnum - 1 Selection.MoveRight Unit:=wdCharacter, Count:=3 Selection.TypeText Text:=" " Next j Selection.MoveRight Unit:=wdCharacter, Count:=3 Selection.TypeParagraph End Function Function addnumber(ByVal lowNum As Integer, ByVal maxNum As Integer) '增加数字行，梯度 5 If lowNum <= maxNum Then Selection.TypeText Text:=vbTab & vbTab & vbTab & vbTab Selection.TypeText Text:=lowNum lowNum = lowNum + 5 End If If lowNum <= maxNum Then Selection.TypeText Text:=vbTab & vbTab & vbTab & vbTab & vbTab Selection.TypeText Text:=lowNum lowNum = lowNum + 5 End If If lowNum <= maxNum Then Selection.TypeText Text:=vbTab & vbTab & vbTab & vbTab & vbTab Selection.TypeText Text:=lowNum lowNum = lowNum + 5 End If End Function Sub SpaceAndNum_2nd() '写下数字，每五个氨基酸注明一个数字>>>>>>>>>>>>>>>> maxNum = Val(InputBox("请输入氨基酸个数", , 30)) '填写 aa 个数 For i = 5 To maxNum + 5 Step 15 If maxNum - i + 5 >= 15 Then Call addblank(15) Call addnumber(i, maxNum) Selection.MoveRight Unit:=wdCharacter, Count:=1 Else If maxNum Mod 15 <> 0 Then Call addblank(maxNum - i + 5) Call addnumber(i, maxNum) Selection.MoveRight Unit:=wdCharacter, Count:=1 End If End If Next i End Sub Function func1to3(ByVal schar As String) '单字母变三字母函数 Dim func As String schar = Asc(UCase(schar)) Select Case schar Case 65: func = "Ala" Case 67: func = "Cys" Case 68: func = "Asp" Case 69: func = "Glu" Case 70: func = "Phe" Case 71: func = "Gly" Case 72: func = "His" Case 73: func = "Ile" Case 75: func = "Lys" Case 76: func = "Leu" Case 77: func = "Met" Case 78: func = "Asn" Case 80: func = "Pro" Case 81: func = "Gln" Case 82: func = "Arg" Case 83: func = "Ser" Case 84: func = "Thr" Case 86: func = "Val" Case 87: func = "Trp" Case 89: func = "Tyr" Case Else func = "" End Select func1to3 = func End Function Sub dayin_1st() '打印出来 1 到 3 的连续序列 >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> txt2 = InputBox("请输入单字母缩写") countn = 0 For i = 1 To Len(txt2) temp = Mid(txt2, i, 1) temp = UCase(temp) If (Asc(temp) >= 65 And Asc(temp) <= 90) Then Selection.TypeText Text:=func1to3(temp) countn = countn + 1 If countn Mod 15 = 0 Then Selection.TypeText Text:=vbCrLf '超过一行 15 个就换行 End If Next i If countn Mod 15 <> 0 Then Selection.TypeText Text:=vbCrLf '最后没有换行，就换一次行 If countn > 0 Then Selection.TypeText Text:="<211> " & countn & vbCrLf End Sub ------------------------------------------------------------------------------- 附录代码 2 ------------------------------------------------------------------------------- Public nwrong As Integer '记录出错的氨基酸单字母个数,如 X Function addblank(ByVal charnum As Integer) '一行中每隔 3 个字符增加一个空格，最后回车 For j = 1 To charnum - 1 Selection.MoveRight Unit:=wdCharacter, Count:=3 Selection.TypeText Text:=" " Next j Selection.MoveRight Unit:=wdCharacter, Count:=3 Selection.TypeParagraph End Function Function addnumber(ByVal lowNum As Integer, ByVal maxNum As Integer) '梯度 5,增加数字行 If lowNum <= maxNum Then Selection.TypeText Text:=vbTab & vbTab & vbTab & vbTab Selection.TypeText Text:=lowNum lowNum = lowNum + 5 End If If lowNum <= maxNum Then Selection.TypeText Text:=vbTab & vbTab & vbTab & vbTab & vbTab Selection.TypeText Text:=lowNum lowNum = lowNum + 5 End If If lowNum <= maxNum Then Selection.TypeText Text:=vbTab & vbTab & vbTab & vbTab & vbTab Selection.TypeText Text:=lowNum lowNum = lowNum + 5 End If End Function Function func1to3(ByVal schar As String) '逐个字母的,单字母变三字母函数 Dim func As String schar = Asc(UCase(schar)) Select Case schar Case 65: func = "Ala" Case 67: func = "Cys" Case 68: func = "Asp" Case 69: func = "Glu" Case 70: func = "Phe" Case 71: func = "Gly" Case 72: func = "His" Case 73: func = "Ile" Case 75: func = "Lys" Case 76: func = "Leu" Case 77: func = "Met" Case 78: func = "Asn" Case 80: func = "Pro" Case 81: func = "Gln" Case 82: func = "Arg" Case 83: func = "Ser" Case 84: func = "Thr" Case 86: func = "Val" Case 87: func = "Trp" Case 89: func = "Tyr" Case Else func = "Aaa" nwrong = nwrong + 1 End Select func1to3 = func End Function Function Geshi() '设置输出格式:宋体，五号字，黑色 Selection.Font.Color = wdColorAutomatic Selection.Font.Size = 10.5 '五号字大约为 10.5 Selection.Font.Name = "宋体" End Function Function dayin_1st() '打印出来 1 到 3 的连续序列，设置文字格式，光标置前，返回氨基酸个数>>>>>> txt2 = Selection.Sentences.Item(1) ' 选取一句话，直到下一个回车键。遇到换行符继续前进 ncount = 0 '记录氨基酸个数 nhuanhang = 0 '记录换行次数 For i = 1 To Len(txt2) temp = Mid(txt2, i, 1) If (Asc(temp) >= 65 And Asc(temp) <= 90) Then temp = UCase(temp) Call Geshi Selection.TypeText Text:=func1to3(temp) ' 调用函数，转换 1 to 3 ncount = ncount + 1 If ncount Mod 15 = 0 Then Selection.TypeText Text:=vbCrLf '超过一行 15 个就换行 nhuanhang = nhuanhang + 1 End If End If Next i If ncount Mod 15 <> 0 Then Selection.TypeText Text:=vbCrLf '最后没有换行，就换一次行 nhuanhang = nhuanhang + 1 End If If ncount > 0 Then Call Geshi Selection.TypeText Text:="<211> " & ncount & vbCrLf nhuanhang = nhuanhang + 1 End If Selection.MoveLeft Unit:=wdCharacter, Count:=ncount * 3 + 6 + Len(ncount) + nhuanhang '光标放到文本最前方 dayin_1st = ncount End Function Sub 宏 2() '写下数字，每五个氨基酸注明一个数字>>>>>>>>>>>>>>>> nwrong = 0 maxNum = Val(dayin_1st()) '调用函数，返回氨基酸个数 For i = 5 To maxNum + 5 Step 15 If maxNum - i + 5 >= 15 Then Call addblank(15) Call addnumber(i, maxNum) Selection.MoveRight Unit:=wdCharacter, Count:=1 Else If maxNum Mod 15 <> 0 Then Call addblank(maxNum - i + 5) Call addnumber(i, maxNum) Selection.MoveRight Unit:=wdCharacter, Count:=1 End If End If Next i Selection.MoveRight Unit:=wdCharacter, Count:=6 + Len(maxNum) + 1 Call Geshi Selection.TypeText Text:="其中错误氨基酸记为 Aaa，数量：" & nwrong & vbCrLf End Sub -------------------------------------------------------------------------------