论文部分内容阅读
题目编号:20100201
积分赏金:50元/80元
挑战者:广东/郑伟龙
原题重现:在以往的Excel难题中,你可能会遇到,在一个表格中,用Sheet1中的A列和Sheet2中的C列的每单元格逐一比对,当相同时,就把Sheet1中B列对应行单元格中内容填充至Sheet2的B列相应的位置,比如Sheet1的A2单元格内容为“电脑爱好者”,Sheet2中C5的单元格的内容也为“电脑爱好者”,那么,就将Sheet1中B2单元格中的CFan填充至Sheet2的B5单元格内。现在问题来了,如果Sheet1中的A列和Sheet2中的C列单元格中的内容只要满足70%的相似度就判定Sheet1中的B列单元格的内容填充至Sheet2中的B列中,这种方法如何实现呢?
一看到这道挑战题,笔者就被出题者那天马行空的思维所折服,在经过几天的折腾之后,好在上天不负有心人啊,最终笔者还是将这个问题解决了。
1.关于相似度的判断
我们这里以挑战题里说的例子为例。假设Sheet1中的A2单元格内容的长度为a,Sheet2中的C5单元格内容的长度为c,它们的公共部分的长度为b,即最长公共子序列的长度(如果对这个名词感到陌生,可参考资料http://baike.baidu.com/view/2020307.htm?fr=ala0_1_1,这里就不详细说明了)。设它们的相似度为q,则q=b/(a+c-b)(见图1)。
2.关于宏代码的编写
打开目标Excel文档,按下组合键Alt+F11,打开Visual Basic编辑器,接着执行菜单栏的“插入→模块”,然后输入以下代码(代码及例表:http://work.newhua.com/cfan/201011/dm.rar):
Sub tiaozhan()
num1 = Sheets(1).[A65536].End(xlUp).Row
num2 = Sheets(2).[C65536].End(xlUp).Row
For i = 1 To num1
For j = 1 To num2
If flag(CStr(Sheets(1).Cells(i, 1).Value), CStr(Sheets(2).Cells(j, 3).Value)) Then
Sheets(2).Cells(j, 3).Offset(0, -1) = Sheets(1).Cells(i, 1).Offset(0, 1).Value
End If
Next
Next
End Sub
Function flag(str1, str2)
Dim arr1(100), arr2(100), C(100, 100) '定义两个一维数组arr1、arr2和一个二维数组C
q = 0.7 '设置相似度,这里设置为0.7(即只要两字符串的相似度为70%)
len1 = CInt(Len(str1))'得到字符串str1的长度
len2 = CInt(Len(str2))'得到字符串str2的长度
For i = 1 To len1 '通过For循环和Mid函数逐个提取str1中的字符,并把这些字符分配到数组arr1
arr1(i) = Mid(str1, i, 1)
Next
For j = 1 To len2
arr2(j) = Mid(str2, j, 1) '通过For循环和Mid函数逐个提取str2中的字符,并把这些字符分配到数组arr2
Next
For i = 0 To len1
C(i, 0) = 0
Next
For j = 0 To len2
C(0, j) = 0
Next
For i = 1 To len1'通过for循环嵌套求出最优公共子序列的长度
For j = 1 To len2
If arr1(i) = arr2(j) Then
C(i, j) = C(i - 1, j - 1) + 1
ElseIf C(i - 1, j) > C(i, j - 1) Then
C(i, j) = C(i - 1, j)
Else
C(i, j) = C(i, j - 1)
End If
Next
Next
q1 = CInt(C(len1, len2)) / (len1 + len2 - CInt(C(len1, len2)))'求出str1和str2的相似度
If q1 > q Then
flag = True
Else
flag = False
End If
End Function
3.关于宏代码的运行
回到Excel文档窗口,运行宏(见图2),就可以将Sheet1中的A列与Sheet2中的C列相比较,如果相似,则将Sheet1中的B列填充到Sheet2中B列。
怎么样?是不是很简单呢?如果想要修改相似度,只需在代码中修改q的值就可以了。
小编点评:不仅解决了问题,还有理论基础,非常不错的方法,只是单元格里如果有回车符,就失灵……
积分赏金:50元/80元
挑战者:广东/郑伟龙
原题重现:在以往的Excel难题中,你可能会遇到,在一个表格中,用Sheet1中的A列和Sheet2中的C列的每单元格逐一比对,当相同时,就把Sheet1中B列对应行单元格中内容填充至Sheet2的B列相应的位置,比如Sheet1的A2单元格内容为“电脑爱好者”,Sheet2中C5的单元格的内容也为“电脑爱好者”,那么,就将Sheet1中B2单元格中的CFan填充至Sheet2的B5单元格内。现在问题来了,如果Sheet1中的A列和Sheet2中的C列单元格中的内容只要满足70%的相似度就判定Sheet1中的B列单元格的内容填充至Sheet2中的B列中,这种方法如何实现呢?
一看到这道挑战题,笔者就被出题者那天马行空的思维所折服,在经过几天的折腾之后,好在上天不负有心人啊,最终笔者还是将这个问题解决了。
1.关于相似度的判断
我们这里以挑战题里说的例子为例。假设Sheet1中的A2单元格内容的长度为a,Sheet2中的C5单元格内容的长度为c,它们的公共部分的长度为b,即最长公共子序列的长度(如果对这个名词感到陌生,可参考资料http://baike.baidu.com/view/2020307.htm?fr=ala0_1_1,这里就不详细说明了)。设它们的相似度为q,则q=b/(a+c-b)(见图1)。
2.关于宏代码的编写
打开目标Excel文档,按下组合键Alt+F11,打开Visual Basic编辑器,接着执行菜单栏的“插入→模块”,然后输入以下代码(代码及例表:http://work.newhua.com/cfan/201011/dm.rar):
Sub tiaozhan()
num1 = Sheets(1).[A65536].End(xlUp).Row
num2 = Sheets(2).[C65536].End(xlUp).Row
For i = 1 To num1
For j = 1 To num2
If flag(CStr(Sheets(1).Cells(i, 1).Value), CStr(Sheets(2).Cells(j, 3).Value)) Then
Sheets(2).Cells(j, 3).Offset(0, -1) = Sheets(1).Cells(i, 1).Offset(0, 1).Value
End If
Next
Next
End Sub
Function flag(str1, str2)
Dim arr1(100), arr2(100), C(100, 100) '定义两个一维数组arr1、arr2和一个二维数组C
q = 0.7 '设置相似度,这里设置为0.7(即只要两字符串的相似度为70%)
len1 = CInt(Len(str1))'得到字符串str1的长度
len2 = CInt(Len(str2))'得到字符串str2的长度
For i = 1 To len1 '通过For循环和Mid函数逐个提取str1中的字符,并把这些字符分配到数组arr1
arr1(i) = Mid(str1, i, 1)
Next
For j = 1 To len2
arr2(j) = Mid(str2, j, 1) '通过For循环和Mid函数逐个提取str2中的字符,并把这些字符分配到数组arr2
Next
For i = 0 To len1
C(i, 0) = 0
Next
For j = 0 To len2
C(0, j) = 0
Next
For i = 1 To len1'通过for循环嵌套求出最优公共子序列的长度
For j = 1 To len2
If arr1(i) = arr2(j) Then
C(i, j) = C(i - 1, j - 1) + 1
ElseIf C(i - 1, j) > C(i, j - 1) Then
C(i, j) = C(i - 1, j)
Else
C(i, j) = C(i, j - 1)
End If
Next
Next
q1 = CInt(C(len1, len2)) / (len1 + len2 - CInt(C(len1, len2)))'求出str1和str2的相似度
If q1 > q Then
flag = True
Else
flag = False
End If
End Function
3.关于宏代码的运行
回到Excel文档窗口,运行宏(见图2),就可以将Sheet1中的A列与Sheet2中的C列相比较,如果相似,则将Sheet1中的B列填充到Sheet2中B列。
怎么样?是不是很简单呢?如果想要修改相似度,只需在代码中修改q的值就可以了。
小编点评:不仅解决了问题,还有理论基础,非常不错的方法,只是单元格里如果有回车符,就失灵……