当范围 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)
其中 Row
和 Column
是解析为数值的表达式。当您需要使用索引引用行或列时,这很方便。
因此,如果您的输出区域是从第 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 Then
和 End 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
我有两个小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)
其中 Row
和 Column
是解析为数值的表达式。当您需要使用索引引用行或列时,这很方便。
因此,如果您的输出区域是从第 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 Then
和 End 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