不循环遍历数组以匹配值

时间:2016-08-02 09:33:16

标签: excel vba excel-vba

由于某些原因,我的代码不起作用,我已经使用过这种类型的代码一千次,无论出于什么原因它都不匹配..当列是空白但是看起来确实如此匹配?关于如何改变这一点甚至改进这一点的任何建议,因为我确实意识到140,000条记录是非常多的!

Dim name1(140000) As String, name2(140000) As String, answer(140000) As String

For i = 1 To 140000
    name1(i) = ActiveWorkbook.Worksheets("Sheet0").Cells(i, 1).value
    name2(i) = ActiveWorkbook.Worksheets("Sheet1").Cells(i, 6).value
    answer(i) = ActiveWorkbook.Worksheets("Sheet0").Cells(i, 13).value

    If name1(i) = name2(i) Then

        answer(i) = "yes"

    End If
Next

2 个答案:

答案 0 :(得分:2)

  

嗨,谢谢,问题是虽然值正在变化,因此表1中的名称可能位于“A1”中,但是表2中的名称位于“F12”中,然后下周可能位于“F14”中所以它只是一种使用代码相应更新的方式,也使用你的vba,仍然没有运气:( - Calum 9分钟前

公式是正确的方法。您可以使用COUNTIF来检查是否存在。将此公式放入单元格M1并将其拉下来。

=IF(COUNTIF($F$1:$F$14000,A1)>0,"Yes","No")

但是,如果您仍想使用代码,请尝试此操作(未经测试

Sub Sample()
    Dim name1 As Variant, name2 As Variant, answer(1 To 14000) As String
    Dim ws As Worksheet
    Dim i As Long

    With ThisWorkbook
        name1 = .Worksheets("Sheet0").Range("A1:A14000").Value
        name2 = .Worksheets("Sheet1").Range("F1:F14000").Value

        For i = 1 To 14000
            If IsInArray(name1(i, 1), name2) Then answer(i) = "Yes" Else answer(i) = "No"
        Next i

        .Worksheets("Sheet1").Range("M1").Resize(UBound(answer), 1).Value = _
        Application.WorksheetFunction.Transpose(answer)
    End With
End Sub

Function IsInArray(stringToBeFound As Variant, arr As Variant) As Boolean
    Dim bDimen As Byte, i As Long

    On Error Resume Next
    If IsError(UBound(arr, 2)) Then bDimen = 1 Else bDimen = 2
    On Error GoTo 0

    Select Case bDimen
    Case 1
        On Error Resume Next
        IsInArray = Application.Match(stringToBeFound, arr, 0)
        On Error GoTo 0
    Case 2
        For i = 1 To UBound(arr, 2)
            On Error Resume Next
            IsInArray = Application.Match(stringToBeFound, Application.Index(arr, , i), 0)
            On Error GoTo 0
            If IsInArray = True Then Exit For
        Next
    End Select
End Function

答案 1 :(得分:0)

您首先从answer(i)Worksheet分配一个值,然后分配Yes值(如果匹配)。

但是,此值会分配给answer()而不是Cell

你需要改变:

answer(i) = "yes"

ActiveWorkbook.Worksheets("Sheet0").Cells(i, 13).Value = "yes"

并完全删除answer()

更好的方法是:

=IF(A1=F1;"Yes";"No")