excel也很有意思啊

老板交待任务要整理大量的电化学数据,加入数据库。

用excel的vba节省了很多机械操作。虽然学习vba也花了不少时间,但是debug和学习vba的过程比一般时间专注多了。

第一个vba代码是批量判断ref electrode并转换到SHE:

[vb]Sub SHE1()
Dim icell As Integer
Dim Eox1 As Variant
Dim SHE1 As Variant
‘Dim Eox2 As Variant
‘Dim SHE2 As Variant
icell = 2
Do Until Cells(icell, 2) = ""
Eox1 = Cells(icell, 3)
SHE1 = Cells(icell, 5)
‘ Eox2 = Cells(icell, 4)
‘ SHE2 = Cells(icell, 6)
If Eox1 <> "" Then
Select Case Cells(icell, 2)
Case "NHE"
SHE1 = Eox1
Case "SCE"
SHE1 = Eox1 + 0.24
Case "Ag+/Ag"
SHE1 = Eox1 + 0.54
Case "Ag wire"
SHE1 = Eox1 + 0.54
Case "Fc+/Fc"
SHE1 = Eox1 + 0.69
Case "Li+/Li"
SHE1 = Eox1 – 3.05
End Select
Cells(icell, 5) = SHE1
Else
Cells(icell, 5) = ""
End If
‘ If Eox2 <> 0 Then
‘ Select Case Cells(icell, 2)
‘ Case "NHE"
‘ SHE2 = Eox2
‘ Case "SCE"
‘ SHE2 = Eox2 + 0.24
‘ End Select
‘ Cells(icell, 6) = SHE2
‘ Else
‘ Cells(icell, 6) = ""
‘ End If
icell = icell + 1
Loop
End Sub[/vb]

第二个是下拉框选择对应分子打开google scholar搜索reversibility的相关信息:

[vb]Private Sub ComboBox1_Change()
Dim na As String
na = ComboBox1.Value ‘get the value of combobox
na1 = na
If Right(na, 1) = "+" Then ‘have to replace + to %2B otherwise + will not be ignored
na = Left(na, Len(na) – 1) + "%2B" ‘left(string, string length) is a string, Left(na, Len(na) – 1) get rid of the lasr string(+ in this case)
End If
ActiveWorkbook.FollowHyperlink Address:="https://scholar.google.com.sg/scholar?hl=zh-CN&q=" + na + "+reversible&btnG=&lr=", NewWindow:=True ‘a way to open a web link
End Sub[/vb]

第三个是最费劲的,根据表中分子名模糊搜索已有分子的数据库,找出重复的:

[vb]Sub check()
Dim rng As Range
Dim arr() As String
Dim k%, rn%, i%, t$
rn = Range("a65536").End(xlUp).Row
ReDim arr(1 To rn – 1)
For i = 1 To rn – 1
arr(i) = Cells(i + 1, 1)
arr(i) = Left(arr(i), 5)
Next
[p2:p1000] = Application.WorksheetFunction.Transpose(arr)
For i = 1 To rn – 1
t = Cells(i + 1, 16)
t = Replace(t, "[", "[[]") ‘replace [, for [ has special function in Like
With Worksheets("database")
For Each rng In .Range("a1:b400")
If rng.Text Like "*" & t & "*" Then
Range("q" & i + 1) = rng.Text
Exit For
Else
Range("q" & i + 1) = "no"
End If
Next
End With
Next
End Sub[/vb]

得到结果的时候很兴奋。

发表评论

40 queries in 1.469 seconds, using 11.67MB memory