Vba Excel：使用OR列条件而不复制行

这是为此的更新版本。

上面的解决方案是好的，直到我意识到当我输入海量数据时，for循环会生成重复的行（这是不需要的结果）

我在网上找到了一些方法来删除重复的行。

ActiveSheet.Range（“ A：F”）。RemoveDuplicates列：= 1，标题：= xlNo

但这会浪费时间来生成更新的数据，然后再删除重复的数据。

我的LOGIC是否造成重复？

现在让我举例说明我的问题，

code name description status    
4566 Adam al          active

因为亚当是一场比赛，而且很活跃，所以我得到4566；记录。
但按照我的逻辑，我又得到了4566。

谢谢你。关于功能/方法或代码的任何建议将不胜感激。

编辑
代码是这组数据中的唯一值。我有Xsheet，其中两列都是独立且不均匀的，但没有重复项（此表是动态的）。

• Sheet1是生成的原始数据，是一个动态数据库。
• Xsheet和Sheet1都是未排序的随机数据。

我正在尝试做的事情。

如果在数据表（Sheet1）中找到了主列表（Xsheet）上的名称或说明，并且该名称或描述也处于活动状态，则将其复制到没有重复的新表中（相同的代码与Sheet2相同）。由于某些代码具有匹配的“名称”和“描述”。

显然，重复不是我遇到的唯一问题，但我认为我应该一次解决一个问题。当我没有其他问题的答复时，我为另一个问题创建了一个新问题。

这是Xsheet。

name    description
Adam    al
Edward  dc
Rose    tp
Jen 
Owen    
Jack    
Belle   
Sally   
Cindy   
Max 
Zack    
Moon    
Shawn   

这是Sheet1。

code    operation   title   date    name    description status
4566                Adam    ttr active
4899                Edward  ttp inactive
4987                Adam    dc  active
4988                Kris    al  active
4989                Chris   ttr inactive
5713                Mary    rt  active
5312                Ken     active
3211                John        active
2138                Summer      active
3334                Wendy       active
5417                Adam        active
3355                Belle       active
4773                Adam        active
3288                Ron     inactive
1289                Wincy   dc  active

这是vba。

Sub Procedure2()

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

Application.ScreenUpdating = False

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

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

Application.ScreenUpdating = True

End Sub