配列をループして値を一致させない

Question

何らかの理由で私のコードが機能しないため、私はこのタイプのコードを何千もの理由で使用しましたが、それは一致しません。一致？ 14万レコードを実現するように、私がこれをどのように変更したり、これを改善することができるかについての提案はかなりたくさんあります。

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 

Answer 1

こんにちは、このためのおかげで、問題は値が変化しているされているものの、そのシート1の名前が「A1」の中にあることが、その後のシート2に「F12」とし、次の週にあるかもしれませんまた:(あなたのVBAと、まだ運を使用し、それに応じて更新するためのコードを使用して、そのだけの方法ので、「F14」になる可能性 - カルム9分前

式は行くための正しい方法ですあなたは。 COUNTIFを使用して存在を確認することができます。この数式をセルM1に入れて、引き下げます。

012それでも、コードを使用したい場合は

しかし、あなたが最初のWorksheetからanswer(i)に値を代入し、それが一致した場合、その後Yes値を代入している。この（未テスト）

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 

Answer 2

を試してみてください。

ただし、Cellではなく、answer()に割り当てられます。

あなたは変更する必要があります。

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

に

answer(i) = "yes" 

を、完全にanswer()を削除します。

---

より良い方法は、このようになります：

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