☰

Vba Excel：使用或列条件而不重复行

tag-icon • tag-icon microsoft-excel worksheet-function vba conditional-statements
Vba Excel：使用或列条件而不重复行

这是更新版本这。

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

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

ActiveSheet.Range("A:F").RemoveDuplicates 列:=1，标题:=xlNo

但生成更新的数据，然后删除重复的数据有点浪费时间。

我的逻辑是否造成了重复？

现在让我举一个例子来说明我的问题，

code name description status    
4566 Adam al          active

因为 Adam 匹配成功并且也处于活跃状态，所以我得到了 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

答案1

这是上次你总结我的情况的一句话。
“如果在数据表中找到主列表上的名称或描述，并且它也是活动的，则将其复制到新表”。

Sub check_listX()

'Set dat = sht.Range("code").Cells(1,1)
Set main = ThisWorkbook.Worksheets("Xsheet").Range("A1")
Set dat = ThisWorkbook.Worksheets("Sheet1").Range("A1")
Set newdat = ThisWorkbook.Worksheets("Sheet2").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 dat.Offset(j, 6).Value = "active" _
      And main.Offset(i, 0) = dat.Offset(j, 4) _
      Or main.Offset(i, 1) = dat.Offset(j, 5) _
      And dat.Offset(j, 5) <> "" 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

相关内容