Vba Excel : 행을 복제하지 않고 OR 열 조건 사용

이것은의 업데이트 버전 이 .

위의 솔루션은 대량의 데이터를 넣을 때 깨달을 때까지 for 루프가 중복 행을 생성합니다 (원치 않는 결과)

중복 행을 제거하는 온라인 방법이 있습니다.

ActiveSheet.Range ( "A : F"). Remove 복제 열 : = 1, 헤더 : = xlNo

그러나 업데이트 된 데이터를 생성 한 후 복제본을 삭제하는 데 약간의 시간이 소요되었습니다.

LOGIC에서 중복이 발생합니까?

지금 내 문제의 예를 들어 보도록하겠습니다.

code name description status    
4566 Adam al          active

아담은 성냥이고 활동 적이기 때문에 4566을받습니다. 기록.
그러나 내 논리에는 4566이 더 있습니다.

감사합니다. 기능 / 방법 또는 코드에 대한 조언을 주시면 감사하겠습니다.

편집
코드는이 데이터 묶음에서 고유 한 값입니다. 두 열이 독립적이고 고르지 않지만 중복이없는 Xsheet가 있습니다 (이 시트는 동적입니다).

• Sheet1은 원래 생성 된 동적 데이터베이스입니다.
• Xsheet와 Sheet1은 모두 정렬되지 않은 임의의 데이터입니다.

내가하려는 일.

마스터 목록 (Xsheet)의 이름 또는 설명이 데이터 시트 (Sheet1)에 있고 활성 상태 인 경우 중복되지 않고 새 시트에 복사합니다 (동일한 코드를 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

지난번에 내 상황을 요약 한 문장입니다.
"마스터 목록의 이름 또는 설명이 데이터 시트에 있고 활성 상태 인 경우 새 시트로 복사하십시오."

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