3

2 つの範囲のデータを比較しようとしています。「A」には 1、2、3、4 が含まれ、「B」には 1、2、5 が含まれます。「B」にあるが「A」にはないものを見つけたいのですが、これは5です。以下は私のコードですが、欲しいものを手に入れることができないようです。誰かアドバイスしてもらえますか？

Dim a As Range, b As Range, i As Integer, x As Integer
Set a = Range("A1:A4")
Set b = Range("B1:B3")

For i = 1 To b.Count
  For x = 1 To a.Count

    If b(i, 1) = a(x, 1) Then

    Else
      MsgBox (b(i, 1))
      Exit For
    End If
  Next x
Next i
4

3 に答える 3

3

または、Excel ワークシート関数を使用した非 VBA ソリューションが必要な場合は、列 C のような列でこの式を試してください

=IF(ISERROR(FIND(B:B,A:A)),B:B&" is not found","")

ここに画像の説明を入力

フィリップ

于 2013-04-25T23:42:33.230 に答える
2

これは非常に小さな範囲ですが、配列を使用して範囲値を保存し、配列を比較に使用することをお勧めします。この例を参照してください。

Sub Sample()
    Dim Ar1, Ar2
    Dim i As Long, j As Long
    Dim Found As Boolean

    Ar1 = Range("A1:A4"): Ar2 = Range("B1:B3")

    For i = LBound(Ar2) To UBound(Ar2)
        Found = False
        For j = LBound(Ar1) To UBound(Ar1)
            If Ar1(j, 1) = Ar2(i, 1) Then
                Found = True
                Exit For
            End If
        Next j

        If Found = False Then Debug.Print Ar2(i, 1) & " Is unique"
    Next i
End Sub

ここに画像の説明を入力

編集

別の方法（私はまだ上記の方法を好みます）

Sub Sample()
    Dim rngA As Range, rngB As Range
    Dim aCell As Range, bCell As Range
    Dim Found As Boolean

    Set rngA = Range("A1:A4"): Set rngB = Range("B1:B3")

    For Each aCell In rngB
        Found = False
        For Each bCell In rngA
            If bCell.Value = aCell.Value Then
                Found = True
                Exit For
            End If
        Next

        If Found = False Then Debug.Print aCell.Value & " Is unique"
    Next
End Sub
于 2013-04-25T23:08:59.080 に答える
1

私は Find() のようなネイティブ VBA 関数を好む傾向があります。特に広い範囲で作業している場合は、少し速く使用できます。

別の解決策は次のとおりです。

Option Explicit
Sub test()
    Dim r1 As Excel.Range
    Dim r2 As Excel.Range

    Set r1 = Sheet1.Range("A1:A4")
    Set r2 = Sheet1.Range("B1:B3")

    Dim s() As String

    s = getUniques(r1, r2)

    Dim i As Long
    For i = 0 To UBound(s)
        Debug.Print s(i)
    Next i
End Sub


Function getUniques(ByRef r1 As Excel.Range, ByRef r2 As Excel.Range) As String()
    Dim cell As Excel.Range
    Dim found As Excel.Range

    Dim uniques() As String
    Dim i As Long

    For Each cell In r2
        On Error Resume Next
        Set found = r1.Find(cell.Value)
        On Error GoTo 0

        If (found Is Nothing) Then
            ReDim Preserve uniques(i)
            uniques(i) = cell.Value
            i = i + 1
        End If
    Next cell

    getUniques = uniques
End Function
于 2013-04-26T01:29:11.767 に答える