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