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

@Dmitry0-01 · Регистрация: 17.09.2021

Студворк — интернет-сервис помощи студентам

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

Помогите реализовать разность и произведение,

shanemac51 · 11.08.2024, 13:47

Сообщение от Dmitry0-01

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

может картинка из интернета вам поможет вспомнить лекции/учебник

@andris2 · 11.08.2024, 19:00

shanemac51, ему нужен готовый код (скопировал/вставил). Зачем голову включать, когда есть инет?

@Jamaica · 24.08.2024, 20:20

Сообщение от Dmitry0-01

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

Экзотическое решение на данных Лист1.

@Dmitry0-01 · 02.09.2024, 09:01 **[ТС]**

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

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
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 Пожалуйста, если нет варианта решение, не спамьте ненужными сообщением темы, перед тем как я, обращаюсь в форум, всегда пробуй различные варианты решение. Заранее благодарю за понимание
Вложения

@elixi · 02.09.2024, 16:29

Сообщение от Dmitry0-01

как видите реализация только пересечение, и обьединение(код представлен нижк), но слегка с ошибками

реализация пересечение
oшибки пoпытался устранить и лoгику вашегo решения сoхранить

Кликните здесь для просмотра всего текста

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
Option Explicit
 
Sub Start()
    Dim A() As String, B() As String
    Dim i%, n%, m%
    Const DFR& = 3  'DataFirstRow = 3 äë˙ Ëčńň1
    'Const DFR& = 4  'DataFirstRow = 4 äë˙ Ëčńň3
    
    i% = DFR
    
    Do
        If Cells(i%, 3).Value = "" Then
            n% = i% - DFR
            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% - DFR
            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
    
    For i% = 1 To n%
        A(i%, 1) = Cells(i% + DFR - 1, 2)
        A(i%, 2) = Cells(i% + DFR - 1, 3)
    Next i%
    
    For i% = 1 To m%
        B(i%, 1) = Cells(i% + DFR - 1, 4)
        B(i%, 2) = Cells(i% + DFR - 1, 5)
    Next i%
    
    Range(Cells(DFR, "F"), Cells(15, "I")).ClearContents
    Stop: Intersect A(), B(), DFR ', ASB(), k1%
 
End Sub
 
Sub Intersect(A() As String, B() As String, DFR&)
'   Ďĺđĺńĺ÷ĺíčĺ A č B
    ReDim AB(1 To 2, 1 To UBound(A, 1) + UBound(B, 1)) As String
    Dim k%, i%, j%, q%
    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) = A(i%, 1) And _
                B(j%, 2) = A(i%, 2) Then
                q% = -1
                Exit For
            End If
        Next j%
        If (q% <> 0) Then
            q% = 0
            For j% = 1 To k%
                If AB(1, j%) = A(i%, 1) And _
                    AB(2, j%) = A(i%, 2) Then
                    q% = -1
                    Exit For
                End If
            Next j%
            If (q% = 0) Then
                k% = k% + 1
                AB(1, k%) = A(i%, 1)   'aa
                AB(2, k%) = A(i%, 2)   'a1
            End If
        End If
    Next i%
 
    ReDim Preserve AB(1 To 2, 1 To k%) As String
    For i% = 1 To UBound(AB, 2)
        Cells(i% + DFR - 1, 6) = AB(1, i%)
        Cells(i% + DFR - 1, 7) = AB(2, i%)
    Next i%
End Sub

реализация обьединение
ваше решение - тут вы навернo шутите, или нет?

Сообщение от Dmitry0-01

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

тoгда давайте выкладывайте ваши пoпытки для обьединение, разность и произведение
будут варианты серьёзных пoпытoк, будет и пoмoщ

Новые блоги и статьи Все статьи Все блоги /
Памятка для бота и "визитка" для читателей "Semantic Universe Layer (Слой семантической вселенной)" Hrethgir 19.04.2026 Сгенерировано для краткого описания по случаю сборки и компиляции скелета серверного приложения. И пусть после этого скажут, что статьи сгенерированные AI - туфта и не интересно. И это не реклама -. . .	Запрет удаления строк ТЧ документа при определенном условии Maks 19.04.2026 Алгоритм из решения ниже реализован на примере нетипового документа "Аккумуляторы", разработанного в конфигурации КА2. У данного документа есть ТЧ, в которой в зависимости от прав доступа. . .	Модель заражения группы наркоманов alhaos 17.04.2026 Условия задачи сформулированы тут Суть: - Группа наркоманов из 10 человек. - Только один инфицирован ВИЧ. - Колются одной иглой. - Колются раз в день. - Колются последовательно через. . .	Мысли в слух. Про "навсегда". kumehtar 16.04.2026 Подумалось тут, что наверное очень глупо использовать во всяких своих установках понятие "навсегда". Это очень сильное понятие, и я только начинаю понимать край его смысла, не смотря на то что давно. . .
My Business CRM MaGz GoLd 16.04.2026 Всем привет, недавно возникла потребность создать CRM, для личных нужд. Собственно программа предоставляет из себя базу данных клиентов, в которой можно фиксировать звонки, стадии сделки, а также. . .	Знаешь почему 90% людей редко бывают счастливыми? kumehtar 14.04.2026 Потому что они ждут. Ждут выходных, ждут отпуска, ждут удачного момента. . . а удачный момент так и не приходит.	Фиксация колонок в отчете СКД Maks 14.04.2026 Фиксация колонок в СКД отчета типа Таблица. Задача: зафиксировать три левых колонки в отчете. Процедура ПриКомпоновкеРезультата(ДокументРезультат, ДанныеРасшифровки, СтандартнаяОбработка) / / . . .	Настройки VS Code Loafer 13.04.2026 { "cmake. configureOnOpen": false, "diffEditor. ignoreTrimWhitespace": true, "editor. guides. bracketPairs": "active", "extensions. ignoreRecommendations": true, . . .

@andris2 508 / 163 / 21 Регистрация: 04.10.2015 Сообщений: 646
	11.08.2024, 19:00
	shanemac51, ему нужен готовый код (скопировал/вставил). Зачем голову включать, когда есть инет? 1

Опции темы