比较2列中的字符串并匹配80%

时间:2018-04-23 17:40:26

标签: excel-vba vba excel

我有一个宏,用于比较两列中字符串的前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

2 个答案:

答案 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

比较列s或t中较小的字符串。

您可以计算字符串字符以找出哪一个更小。

    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
相关问题