当范围 A 中的单元格存在于范围 B 中时,然后将两者复制到表格下方的行中

When cell from range A exists in Range B then copy both into rows below tables

我有两个小tables。

第一个包含 3 列和 5 行。第二个包含 4 列和 5 行。

当第一个 table(第 3 列)的单元格值等于第二个(table 第 3,4 列)的单元格值时,我需要复制这些单元格的 ID(第 1 列和第 2 列) tables) 假设下面的 10 行,所以我得到另一个小的 tables,在那里我会看到来自两个 tables 的所有 ID 都是相等的。

我可以用 IF 语句来做到这一点,但工作量很大,我正在寻找更好的解决方案。

我开发了那个简单的代码,但我需要一遍又一遍地重复...

Sub test()

    If Range("C6").Value = Range("G6").Value Then
        Range("B6").Copy
        Range("B20").PasteSpecial
        Range("F6").Copy
        Range("C20").PasteSpecial
    End If

End Sub

编辑

我在 table A 中有重复,我希望如果值 ROL 在 table 中出现两次,它的 ID 也应该被复制两次。

Dim cl As Range 

For Each cl In Range("C6:C15")
    If cl.Value = "CHEM" Then
        cl.Offset(0, 2).Copy
        Range("B25").PasteSpecial
        Range("C25").Value = 1
    End If
    If cl.Value = "ROL" Then
        cl.Offset(0, 2).Copy
        Range("B26").PasteSpecial
        Range("C26").Value = 2 
    End If 
Next 

你写的正是我需要做的。我试图完成你给的代码,但我做错了什么。一旦两个值匹配,我需要复制它们的 ID 并粘贴到 B26 和 C26 旁边的单元格 B25 和 C25 等。请看下面的代码。我收到错误消息 cla.Offset(0,-2).Copy(应用程序定义或对象定义)。我怎样才能把代码粘贴到这里,就像你做的那样? –

Dim cla As Range
Dim clb As Range

For Each cla In Range("A6:C15") 'first range of values
    For Each clb In Range("E7:G13") 'second range of values
        If cla.Value = clb.Value Then
            clb.Offset(0, -2).Copy
            cla.Offset(0, -2).Copy
            Range("B25").PasteSpecial
            Range("C25").PasteSpecial
        End If
    Next
Next

这就是代码现在的样子。不幸的是,复制的内容不正确。我会解释。

在范围 1 中有 ID 为 1 的值 INF。 在范围 2 中有 ID 为 3 的值 INF。

一旦两个值满足,则输出应为 1,3。 现在是1,1。此外,还复制了 INF 值(不应复制)。

Dim cla As Range
Dim clb As Range

Dim R As Long 'declare variable that will refer to a row value
R = 25        'and initialize R to the first row, where to output pairs when found

For Each cla In Range("A6:C15") 'first range of values
    For Each clb In Range("E7:G13") 'second range of values
        If cla.Value = clb.Value Then
            Cells(R, 2) = cla.Value
            Cells(R, 3) = clb.Value
            R = R + 1
        End If
    Next
Next

这里有两个 table。 在 tables 下面你可以看到输出应该是什么。

Table 1                     Table 2
ID Surname   Lesson type    ID  Lesson name Lesson Type
1  Smith      INF           1    Chemia       CHEM
2  Kowalski   ROL           2    Agro         ROL
3  Smith      FIZ           3    Infor        INF
4  Kowalski   CHEM          4    Fizyka       FIZ
5  Smith      EKON          5    Matem        MAT
6  Kowalski   ROL           6    Ekonom       EKON
7  Smith      ROL           7    Maszyny      FIZ 
8  Kowalski   FIZ
9  Smith      MAT
10 Kowalski   EKON

ID table1 ID table2
   1         3
   2         2
   3         4           
   3         7
   4         1
   5         6
   6         2

等...

我确定我的目的不是像您在评论中显示的那样在您的代码中输入实际值。

关于循环安排,考虑从 table A 中读取一个值,然后对照 table B 中的每个值检查该值。然后再次从 A 中读取下一个值,然后再次检查 B 中的所有值等等...这需要嵌套循环

For Each cla In Range("A6:C10") 'first range of values
    For Each clb In Range("E6:H10") 'second range of values
        If cla.Value = clb.Value Then
            'hit found, copy (or move) values to output area,
            'increment output area line number
        End If
    Next
Next

找到匹配项后,将值复制(或移动,如果这是您的任务)到输出区域。继续循环直到A和B的最后一项。


加法

您确实知道如何使用 Range() 对象引用单元格。另一种方法是使用 Cells(): Cells(Row, Column) 其中 RowColumn 是解析为数值的表达式。当您需要使用索引引用行或列时,这很方便。

因此,如果您的输出区域是从第 25 行开始的 B 列和 C 列,您可以在 For 循环之前执行:

Dim R As Long 'declare variable that will refer to a row value
R = 25        'and initialize R to the first row, where to output pairs when found

If cla.Value = clb.Value ThenEnd If 之间的代码中删除您当前拥有的内容并添加...

            Cells(R, 2) = cla.Value 
            Cells(R, 3) = clb.Value
            R = R + 1

...复制值并增加 R 以准备稍后的其他匹配。

请注意,输出列是常量(2 和 3),因为它们不需要更改。


最终编辑:

好的,既然您发布了实际数据,我理解您之前 Offset(0, -2) 的补充。这是正确的,因为您需要 ID 而不是 Lesson type。这是固定范围内的 Paste,这使得它无法按预期工作。您可以完全避免 copy - paste,而是直接将值分配给正确的单元格。

无论如何,在“C”和“F”列中使用以下 For 循环和 Lesson type,我得到以下结果。

For Each cla In Range("C7:C16")
    For Each clb In Range("F7:F13")
        If cla.Value = clb.Value Then
            Cells(R, 2) = cla.Offset(0, -2)
            Cells(R, 3) = clb.Offset(0, -2)
            R = R + 1
        End If
    Next
Next

第 2 列和第 3 列(或 B 和 C)中的结果

ID table1 ID table2
        1        3
        2        2
        3        4
        3        7
        4        1
        5        6
        6        2
        7        2
        8        4
        8        7
        9        5
       10        6