我有一个宏,用于比较两列中字符串的前20个字符,当客户类型为" O"并给出结果。但我需要比较这两列,如果80%的字符串匹配,我需要得到结果为" ok"否则"检查"。有人可以帮我纠正我的代码。感谢
Sub Macro1()
'
'Match Organization names only the first 20 characters
'
'
Dim sht As Worksheet
Dim LR As Long
Dim i As Long
Dim str As String, str1 As String
Set sht = ActiveWorkbook.Worksheets("ORD_CS")
LR = sht.UsedRange.Rows.Count
With sht
For i = 8 To LR
If CStr(.Range("Q" & i).Value) = "O" Then
str = Left(.Range("S" & i).Value, 20)
str1 = Left(.Range("U" & i).Value, 20)
If str = str1 Then
Range("V" & i).Value = "ok"
Else
Range("V" & i).Value = "check"
End If
End If
Next i
End With
End Sub
答案 0 :(得分:0)
只需跟踪点击次数并将其除以您正在查看的总行数:
Sub Macro1()
'
'Match Organization names only the first 20 characters
'
'
Dim sht As Worksheet
Dim LR As Long
Dim i As Long
Dim str As String, str1 As String
Dim totalRows as Long, Dim matchRows as Long
Set sht = ActiveWorkbook.Worksheets("ORD_CS")
LR = sht.UsedRange.Rows.Count
totalRows = LR-8
With sht
For i = 8 To LR
If CStr(.Range("Q" & i).Value) = "O" Then
str = Left(.Range("S" & i).Value, 20)
str1 = Left(.Range("U" & i).Value, 20)
If str = str1 Then
Range("V" & i).Value = "ok"
matchRows = matchRows + 1
Else
Range("V" & i).Value = "check"
End If
End If
Next i
End With
'heres ther percentage of hits:
if matchRows/totalRows > .8 Then
msgbox "OK"
else
msgbox "Check"
End if
End Sub
如果它不是您要查找的总匹配行的80%,而是与字符串进行比较以获得它们的大致匹配程度,您可以实现Levenshtein距离函数并使用它进行比较那。 See here for a VBA function that will do that which should be easy to implement in your code
答案 1 :(得分:0)
也许使用len()并乘以.8
Sub Button1_Click()
Dim LstRw As Long, Rng As Range, sh As Worksheet, c As Range
Set sh = Sheets("ORD_CS")
With sh
LstRw = .Cells(.Rows.Count, "S").End(xlUp).Row
Set Rng = .Range("S2:S" & LstRw)
For Each c In Rng.Cells
If InStr(1, c.Offset(, 2), Left(c, Len(c) * 0.8)) Then
c.Offset(, 3) = "Yep"
Else: c.Offset(, 3) = "Nope"
End If
Next c
End With
End Sub
您可以计算字符串字符以找出哪一个更小。
Sub Button1_Click()
Dim LstRw As Long, Rng As Range, sh As Worksheet, c As Range
Set sh = Sheets("ORD_CS")
With sh
LstRw = .Cells(.Rows.Count, "S").End(xlUp).Row
Set Rng = .Range("S2:S" & LstRw)
For Each c In Rng.Cells
x = IIf(Len(c) < Len(c.Offset(, 1)), 0, 1)
If InStr(1, .Cells(c.Row, "U"), Left(c.Offset(, x), Len(c.Offset(, x)) * 0.8)) Then
.Cells(c.Row, "V") = "Yep"
Else: .Cells(c.Row, "V") = "Nope"
End If
Next c
End With
End Sub