☰

excel vba：如果数据与另一张表中的列中的值匹配，则复制行

tag-icon • tag-icon microsoft-excel worksheet-function vba
excel vba：如果数据与另一张表中的列中的值匹配，则复制行

我已经问了一个相关问题这里。
阿德莱德爵士为我提供了这个非常有用的解决方案。

所以现在，在这个几乎相似的情况下，我的工作簿中有 2 个 Excel 表。
[Xsheet][1] 工作表1

我将循环遍历 Sheet1 中的名称和描述列，看看它是否与名称中的值匹配或者XSheet 中的描述列（列中可能会有无限的数据行）。如果确实如此，则 Sheet1 中的“该”行将被复制到新的 Sheet2 中。

我对之前的代码（由阿德莱德爵士提供）做了一点修改，

Sub Procedure2()

Dim xsht As Worksheet
Dim sht As Worksheet 'original sheet
Dim newsht As Worksheet 'sheet with new data

Set xsht = ThisWorkbook.Worksheets("Xsheet")
Set sht = ThisWorkbook.Worksheets("Sheet1")
Set newsht = ThisWorkbook.Worksheets("Sheet2")

'Set dat = sht.Range("code").Cells(1,1)
Set main = xsht.Range("A1")
Set dat = sht.Range("A1")
Set newdat = newsht.Range("A1")

'initialise counters
i = 1
j = 1

'set heading on sheet2
newdat.Offset(0, 0).Value = dat.Offset(0, 0).Value 'copy code
newdat.Offset(0, 1).Value = dat.Offset(0, 2).Value 'copy title
newdat.Offset(0, 2).Value = dat.Offset(0, 3).Value 'copy date
newdat.Offset(0, 3).Value = dat.Offset(0, 4).Value 'copy name
newdat.Offset(0, 4).Value = dat.Offset(0, 5).Value 'copy descr
newdat.Offset(0, 5).Value = dat.Offset(0, 6).Value 'copy status

Do While dat.Offset(i, 0).Value <> "" 'loop row till code data goes blank
  If ((main.Offset(i, 0).Value = dat.Offset(i, 4).Value Or _
  main.Offset(i, 1).Value = dat.Offset(i, 5).Value) And dat.Offset(i, 6).Value = "active") Then 'check conditions
    newdat.Offset(j, 0).Value = dat.Offset(i, 0).Value 'copy code
    newdat.Offset(j, 1).Value = dat.Offset(i, 2).Value 'copy title
    newdat.Offset(j, 2).Value = dat.Offset(i, 3).Value 'copy date
    newdat.Offset(j, 3).Value = dat.Offset(i, 4).Value 'copy name
    newdat.Offset(j, 4).Value = dat.Offset(i, 5).Value 'copy descr
    newdat.Offset(j, 5).Value = dat.Offset(i, 6).Value 'copy status
    j = j + 1
  End If

  i = i + 1
Loop

任何建议都将不胜感激。谢谢。
输出 嗨，我尝试运行更新后的代码。
这是我的输出，但有一个不活跃的情况，这是不正确的。
正确的输出应该是 4566,4987,4988。
我已经检查过代码，不知道哪里出了问题

我删除了 Xsheet 链接，因为我的声誉不足以创建超过 2 个超链接

我现在循环遍历 Sheet1 以查看它是否与 Xsheet 中的列匹配。4566
，它与名称 col 中的“Adam”匹​​配（因为它的名称或者描述，所以如果名称匹配那么它就是匹配的），并且（需要）活跃，所以它就进入了。4899
，爱德华是匹配的（或任何描述），但没有匹配和活跃，所以没有。4987
，与 4566 的情况相同，是 Adam 并且活跃。4988
，Kris（不是匹配名称），但 al 在 Xsheet 的描述中，并且活跃，所以它在里面。4989
，Chris 不是匹配名称，ttr 不是匹配描述，即使它是一个活跃的案例（我也不会接受它）

感谢您迄今为止的指导。我非常感激。

答案1

因此，在弄清楚你真正在做什么之后。问题很简单：


“如果在数据表中找到主列表上的名称或描述并且它也处于活动状态，则将其复制到新表”。

逻辑运算符：优先顺序

这是针对您最近的评论的代码的修订版。

Sub Procedure2()

Dim xsht As Worksheet
Dim sht As Worksheet 'original sheet
Dim newsht As Worksheet 'sheet with new data

Set xsht = ThisWorkbook.Worksheets("Xsheet")
Set sht = ThisWorkbook.Worksheets("Sheet1")
Set newsht = ThisWorkbook.Worksheets("Sheet2")

'Set dat = sht.Range("code").Cells(1,1)
Set main = xsht.Range("A1")
Set dat = sht.Range("A1")
Set newdat = newsht.Range("A1")

'initialise counters
Dim i, j, iRow As Integer   'instantiate and initialize the integers
i = 1
j = 1
iRow = 1

'set heading on sheet2
newdat.Offset(0, 0).Value = dat.Offset(0, 0).Value 'copy code
newdat.Offset(0, 1).Value = dat.Offset(0, 2).Value 'copy title
newdat.Offset(0, 2).Value = dat.Offset(0, 3).Value 'copy date
newdat.Offset(0, 3).Value = dat.Offset(0, 4).Value 'copy name
newdat.Offset(0, 4).Value = dat.Offset(0, 5).Value 'copy descr
newdat.Offset(0, 5).Value = dat.Offset(0, 6).Value 'copy status

Do While main.Offset(i, 0).Value <> "" Or main.Offset(i, 1).Value <> ""

  j = 1     'reset DataSheet pointer

  Do While dat.Offset(j, 0).Value <> ""

    If (main.Offset(i, 0).Value = dat.Offset(j, 4).Value _
    Or main.Offset(i, 1).Value = dat.Offset(j, 5).Value) _
    And dat.Offset(j, 6).Value = "active" Then

      newdat.Offset(iRow, 0).Value = dat.Offset(j, 0).Value 'copy code
      newdat.Offset(iRow, 1).Value = dat.Offset(j, 2).Value 'copy title
      newdat.Offset(iRow, 2).Value = dat.Offset(j, 3).Value 'copy date
      newdat.Offset(iRow, 3).Value = dat.Offset(j, 4).Value 'copy name
      newdat.Offset(iRow, 4).Value = dat.Offset(j, 5).Value 'copy descr
      newdat.Offset(iRow, 5).Value = dat.Offset(j, 6).Value 'copy status
      iRow = iRow + 1
    End If
    j = j + 1     'increment DataSheet pointer; fast moving; changing/resetting
  Loop

  i = i + 1     'increment XSheet pointer; slow moving outer loop; not resetting
Loop
End Sub

此次修订后的代码四项变革。在 OUTER 循环中添加了检查，以通过添加来包含 Name 字段中的空白Or main.Offset(i, 1).Value <> ""。信息评估位置的变化在 If 语句中，从 i-to-i_value 到 i-to-j_value. 添加用于数据放置的第三个计数器在新工作表中将数据复制到 Sheet2。最后，嵌套循环（循环内循环）。循环外：逐行查看主列表 (xSheet)；永不重复。循环内：查看数据表以从上到下进行比较；重复主列表中的每个新行。


您甚至可以更改 If 语句以考虑“active”与“Active”，或“A”或“a”。这是下拉列表派上用场的地方，但这本身就是另一个问题。

If (main.Offset(i, 0).Value = dat.Offset(j, 4).Value _
Or main.Offset(i, 1).Value = dat.Offset(j, 5).Value) _
And (dat.Offset(j, 6).Value = "active" Or dat.Offset(j, 6).Value = "Active") Then

相关内容