excel 中用VBA怎么判断一列文本中是否包含另一列文本中的文本?
excel中怎么判断一列文本中是否包含另一列文本中的文本,求VBA代码?比如我现在有Sheet1数据如下:AB地市地址梅州市梅州市大埔分公司大麻镇新马路201梅州市梅州市...
excel 中怎么判断一列文本中是否包含另一列文本中的文本,求VBA代码?
比如我现在有Sheet1数据如下:
A B
地市 地址
梅州市 梅州市大埔分公司大麻镇新马路201
梅州市 梅州市蕉岭分公司广福镇·乐干村· 蕉林坝·61号
梅州市 梅州市梅江分公司金山 福长村 官岌村民小组
梅州市 梅州市梅江分公司罗卜坪钟屋12号
梅州市 梅州市梅县分公司丙村镇交通街16号丙村信联服务厅
梅州市 梅州市梅县分公司梅县西阳镇福利区21栋605
梅州市 梅州市兴宁分公司坭陂镇将军村老胡屋
云浮市 云浮市罗定分公司罗平镇榃感东街24号
云浮市 云浮市新兴分公司新城镇仓夏村上坊65号
潮州市 潮州市庵埠潮汕公路文里灰路头樱花楼3号
潮州市 潮州市潮安县凤塘镇和安村路边见顺药店
潮州市 潮州市潮安县磷溪镇仙河村
潮州市 潮州市潮安县沙溪镇高厦一村南溪宫前一横8号
潮州市 潮州市潮安县沙溪镇刘畔村
Sheet2数据如下:
A B C
梅州市 云浮市 潮州市
乐干村 罗平镇 和安村
大麻镇 沙溪镇
丙村镇
怎么实现先判断Sheet1中A列的市,再判断B列地址中的文本是否包含Sheet2中对应市列中的文本,如果某列包含,就将某列用颜色标识?
急用,就高手解决,感谢万分! 展开
比如我现在有Sheet1数据如下:
A B
地市 地址
梅州市 梅州市大埔分公司大麻镇新马路201
梅州市 梅州市蕉岭分公司广福镇·乐干村· 蕉林坝·61号
梅州市 梅州市梅江分公司金山 福长村 官岌村民小组
梅州市 梅州市梅江分公司罗卜坪钟屋12号
梅州市 梅州市梅县分公司丙村镇交通街16号丙村信联服务厅
梅州市 梅州市梅县分公司梅县西阳镇福利区21栋605
梅州市 梅州市兴宁分公司坭陂镇将军村老胡屋
云浮市 云浮市罗定分公司罗平镇榃感东街24号
云浮市 云浮市新兴分公司新城镇仓夏村上坊65号
潮州市 潮州市庵埠潮汕公路文里灰路头樱花楼3号
潮州市 潮州市潮安县凤塘镇和安村路边见顺药店
潮州市 潮州市潮安县磷溪镇仙河村
潮州市 潮州市潮安县沙溪镇高厦一村南溪宫前一横8号
潮州市 潮州市潮安县沙溪镇刘畔村
Sheet2数据如下:
A B C
梅州市 云浮市 潮州市
乐干村 罗平镇 和安村
大麻镇 沙溪镇
丙村镇
怎么实现先判断Sheet1中A列的市,再判断B列地址中的文本是否包含Sheet2中对应市列中的文本,如果某列包含,就将某列用颜色标识?
急用,就高手解决,感谢万分! 展开
4个回答
展开全部
以下代码按你的要求,两边都设置啦颜色,且在表1中标出啦对应表2中的单元格地址。
Sub 数据对比()
Dim a As Integer, b As Integer, c As Integer, d As Integer
a = Sheets(1).UsedRange.Columns.Count
b = Sheets(1).UsedRange.Rows.Count
c = Sheets(2).UsedRange.Columns.Count
d = Sheets(2).UsedRange.Rows.Count
arr = Sheets(1).UsedRange
brr = Sheets(2).UsedRange
For x = 1 To b
For y = 1 To UBound(brr, 2)
If Trim(arr(x, 1)) = Trim(brr(1, y)) Then
For Z = 3 To d
temp = InStr(1, arr(x, 2), brr(Z, y), 1)
If temp > 0 And brr(Z, y) <> full Then
Sheets(1).Cells(x, 3).Value = "对应表2中的单元格地址为" & Sheets(2).Cells(Z, y).Address
Sheets(1).Cells(x, 1).Font.Color = vbRed
Sheets(2).Cells(Z, y).Font.Color = vbRed
Sheets(1).Cells(x, 2).Characters(temp, Len(brr(Z, y))).Font.Color = vbRed
End If
Next Z
End If
Next y
Next
End Sub
Sub 数据对比()
Dim a As Integer, b As Integer, c As Integer, d As Integer
a = Sheets(1).UsedRange.Columns.Count
b = Sheets(1).UsedRange.Rows.Count
c = Sheets(2).UsedRange.Columns.Count
d = Sheets(2).UsedRange.Rows.Count
arr = Sheets(1).UsedRange
brr = Sheets(2).UsedRange
For x = 1 To b
For y = 1 To UBound(brr, 2)
If Trim(arr(x, 1)) = Trim(brr(1, y)) Then
For Z = 3 To d
temp = InStr(1, arr(x, 2), brr(Z, y), 1)
If temp > 0 And brr(Z, y) <> full Then
Sheets(1).Cells(x, 3).Value = "对应表2中的单元格地址为" & Sheets(2).Cells(Z, y).Address
Sheets(1).Cells(x, 1).Font.Color = vbRed
Sheets(2).Cells(Z, y).Font.Color = vbRed
Sheets(1).Cells(x, 2).Characters(temp, Len(brr(Z, y))).Font.Color = vbRed
End If
Next Z
End If
Next y
Next
End Sub
追问
万分感谢!刚实验成功。请问表2中的数据可以无限拓展吗?
追答
可以的,但不能超过excel的最大行数和最大列数。
如果你想把设置好的格式以及标注的位置取消也可以的哦!代码已经写好啦!需要的话,可以给你啊!
本回答被提问者采纳
已赞过
已踩过<
评论
收起
你对这个回答的评价是?
展开全部
用vlookup匹配,不难 没分啊VBA也好做
已赞过
已踩过<
评论
收起
你对这个回答的评价是?
展开全部
不太明白,把EXCEL发来看一下,应该好做。
已赞过
已踩过<
评论
收起
你对这个回答的评价是?
推荐律师服务:
若未解决您的问题,请您详细描述您的问题,通过百度律临进行免费专业咨询