前言:最近在做一个地址标准化的竞赛,里面包括了地址提取、分词、清洗、匹配等一系列动作,等这次竞赛结束后会专门写一篇文章分享源码。
之所以要做标题的事情,是因为用了这么多年的Excel,还是习惯Excel的界面,而且因为这次初赛数据量并不大(500条),分数也达到了了一个瓶颈(98.2分),不清楚应该如何提升,所以就想一条条看看到底错在那里。第一步就是要判断提取出来的地址是否准确。
如上图所示,我想要的结果就是根据C列,判断B列里是否有一样的内容,如果有的话就用红色标记,使用VBA很简单,不过也查了蛮多资料才写好。
Sub 自动标红()
maxrow = Sheets("Sheet1").UsedRange.Rows.Count
For i = 2 To maxrow
thistext = Range("B" & i)
thisaddress = Range("C" & i)
S = Len(thisaddress)
If InStr(thistext, thisaddress) > 0 Then
With Range("B" & i).Characters(InStr(thistext, thisaddress), S).Font
.Color = vbRed
End With
Else:
'因为我之前提取的地址,部分会加上省名(2个字符),这样就会找不到,所以使用mid进行切分和提取
new_address = Mid(thisaddress, 3)
S = Len(new_address)
If InStr(thistext, new_address) > 0 Then
With Range("B" & i).Characters(InStr(thistext, new_address), S).Font
.Color = vbRed
End With
End If
End If
Next
End Sub
需要注意的是,Characters前必须用Range(“B” & i)而不能用thistext代替,否则会报错。