Множество: пересечение, обьединение, разность и произведение

[dmitry]

Здравствуйте, помогите пожалуйста, необходимо написать код, для VBA на основании таблиц R1 и R2, должны быть сделаны операции, а именно пересечение, обьединение, разность и произведение, как видите реализация только пересечение, и обьединение(код представлен нижк), но слегка с ошибками, разность и произведение, просто нет возможности сделать?

Код Выделить Развернуть

Sub Start()
Dim A() As String
Dim B() As String
Dim ASB() As String
Dim AUB() As String
i% = 3

Do
If Cells(i%, 4).Value = "" Then
n% = i% - 3
Exit Do
End If
i% = i% + 1
Loop

If n% = 0 Then
MsgBox "?????? A ????"
Exit Sub
End If

i% = 3
Do
If Cells(i%, 5).Value = "" Then
m% = i% - 3
Exit Do
End If
i% = i% + 1
Loop

If m% = 0 Then
MsgBox "?????? B ????"
Exit Sub
End If

ReDim A(1 To n%, 1 To 2) As String
ReDim B(1 To m%, 1 To 2) As String
ReDim ASB(1 To n% + m%, 1 To 2) As String
ReDim AUB(1 To n% + m%, 1 To 2) As String

For i% = 1 To n%
A(i%, 1) = Cells(i% + 2, 2)
A(i%, 2) = Cells(i% + 2, 3)
Next i%

For i% = 1 To m%
B(i%, 1) = Cells(i% + 2, 4)
B(i%, 2) = Cells(i% + 2, 5)
Next i%

Range("F6:I40").Select
Selection.ClearContents
Range("A1").Select

Intersect A(), B(), ASB(), k1%

For i% = 1 To k1%
Cells(i% + 2, 6) = ASB(i%, 1)
Cells(i% + 2, 7) = ASB(i%, 2)
Next i%

End Sub

Sub Intersect(A() As String, B() As String, AB() As String, k As Integer)
k% = 0
For i% = 1 To UBound(A, 1)
aa = A(i%, 1)
a1 = A(i%, 2)
q% = 0
For j% = 1 To UBound(B, 1)
If B(j%, 1) = aa Then
q% = -1
Exit For
End If
Next j%
If (q% <> 0) Then
q% = 0
For j% = 1 To k%
If AB(j%, 1) = aa Then
q% = -1
Exit For
End If
Next j%
If (q% = 0) Then
k% = k% + 1
AB(k%, 1) = aa
AB(k%, 2) = a1
End If
End If
Next i%

Range("H3").Select
ActiveCell.FormulaR1C1 = "=RC[-6]"
Range("H4").Select
Range("H3").Select
ActiveCell.FormulaR1C1 = "=RC[-6]"
Range("I3").Select
ActiveCell.FormulaR1C1 = "=RC[-6]"
Range("H4").Select
ActiveCell.FormulaR1C1 = "=RC[-6]"
Range("I4").Select
ActiveCell.FormulaR1C1 = "=RC[-6]"
Range("H5").Select
ActiveCell.FormulaR1C1 = "=RC[-6]"
Range("I5").Select
ActiveCell.FormulaR1C1 = "=RC[-6]"
Range("H6").Select
ActiveCell.FormulaR1C1 = "=RC[-6]"
Range("I6").Select
ActiveCell.FormulaR1C1 = "=RC[-6]"
Range("H7").Select
ActiveCell.FormulaR1C1 = "=RC[-6]"
Range("I7").Select
ActiveCell.FormulaR1C1 = "=RC[-6]"
Range("H8").Select
ActiveCell.FormulaR1C1 = "=R[-5]C[-4]"
Range("I8").Select
ActiveCell.FormulaR1C1 = "=R[-5]C[-4]"
Range("H9").Select
ActiveCell.FormulaR1C1 = "=R[-5]C[-4]"
Range("I9").Select
ActiveCell.FormulaR1C1 = "=R[-5]C[-4]"
Range("H10").Select
ActiveCell.FormulaR1C1 = "=R[-5]C[-4]"
Range("I10").Select
ActiveCell.FormulaR1C1 = "=R[-5]C[-4]"
Range("H11").Select
ActiveCell.FormulaR1C1 = "="
Range("H10").Select
ActiveCell.FormulaR1C1 = "=R[-4]C[-4]"
Range("I10").Select
ActiveCell.FormulaR1C1 = "=R[-4]C[-4]"
Range("H11").Select
ActiveCell.FormulaR1C1 = "=R[-4]C[-4]"
Range("I11").Select
ActiveCell.FormulaR1C1 = "=R[-4]C[-4]"
Range("I12").Select

End Sub
P.S Пожалуйста, если нет варианта решение, не спамьте ненужными сообщением темы, перед тем как я, обращаюсь в форум, всегда пробуй различные варианты решение. Заранее благодарю за понимание

Код оформляйте тегом code.

[doober]

Как понял, так и решил задачу.Произведение R1 и R2 -не понял физического смысла

Код Выделить Развернуть

Sub StartNew()
    Dim Sh As Worksheet, out()
    Set Sh = ThisWorkbook.Worksheets("Лист3")
    LastRow = Sh.Cells(Sh.Rows.Count, 2).End(xlUp).Row
    Sh.Range("F4:K40").ClearContents
    dx = Sh.Range("B4:C" & LastRow)
    LastRow = Sh.Cells(Sh.Rows.Count, 4).End(xlUp).Row
    dx1 = Sh.Range("D4:E" & LastRow)
    Set C_is = CreateObject("scripting.dictionary")
    Set C_is1 = CreateObject("scripting.dictionary")
    Set AL1 = CreateObject("system.collections.arraylist")

    Set AL = CreateObject("system.collections.arraylist")

    For n = 1 To UBound(dx)
        Key$ = dx(n, 1) & "_" & dx(n, 2)
        C_is.Item(Key) = n
        AL.Add n
    Next
    For n = 1 To UBound(dx1)
        Key$ = dx1(n, 1) & "_" & dx1(n, 2)
        C_is1.Item(Key) = n
        AL1.Add n
    Next
    'Пересечение
    Keys = C_is.Keys
    ct = 3
    For n = 0 To C_is.Count - 1
        Key$ = Keys(n)
        If C_is1.Exists(Key) Then
            ct = ct + 1
            i = C_is.Item(Key)
            j = C_is1.Item(Key)
            AL.Remove i
            AL1.Remove j
            Sh.Range("F" & ct).Resize(1, 2) = Array(dx(i, 1), dx(i, 2))
        End If
    Next
    'объединение
    ct = 4
    Sh.Range("h4").Resize(UBound(dx), UBound(dx, 2)) = dx
    ct = ct + UBound(dx)
    Sh.Range("h" & ct).Resize(UBound(dx1), UBound(dx1, 2)) = dx1

    'Разность

    A = AL.toarray
    A1 = AL1.toarray
    Count = AL1.Count + AL.Count
    ReDim Preserve out(1 To Count, 1 To 2)
    ct = 0
    For n = 0 To AL.Count - 1
        ct = ct + 1
        out(ct, 1) = dx(A(n), 1)
        out(ct, 2) = dx(A(n), 2)

    Next

    For n = 0 To AL1.Count - 1
        ct = ct + 1
        out(ct, 1) = dx(A1(n), 1)
        out(ct, 2) = dx(A1(n), 2)

    Next
    Sh.Range("j4").Resize(UBound(out), UBound(out, 2)) = out
End Sub