Vba Excel: OR-Spaltenbedingung verwenden, ohne Zeile zu duplizieren

403
ExcelNovice

Dies ist eine aktualisierte Version dafür .

Die obige Lösung ist gut, bis mir klar wurde, dass die for-Schleife doppelte Zeilen generiert (was zu unerwünschten Ergebnissen führt).

Ich habe online eine Methode gefunden, um doppelte Zeilen zu entfernen.

ActiveSheet.Range ("A: F"). RemoveDuplicates-Spalten: = 1, Header: = xlNo

Es war jedoch etwas Zeitverschwendung, die aktualisierten Daten zu generieren und die Duplikate danach zu löschen.

Verursacht mein LOGIC Duplikate?

Lassen Sie mich jetzt ein Beispiel für mein Problem angeben,

code name description status  4566 Adam al active 

Weil Adam ein Streichholz ist und auch aktiv ist, bekomme ich 4566; der Datensatz.
Aber in meiner Logik bekomme ich noch 4566.

Vielen Dank. Hinweise zu Funktion / Methode oder Code werden gebeten.

Der EDIT-
Code ist der eindeutige Wert in dieser Gruppe von Daten. Ich habe Xsheet, wo beide Spalten unabhängig und ungerade sind, aber keine Duplikate (dieses Blatt ist dynamisch).

  • Sheet1 ist das generierte Original, eine dynamische Datenbank.
  • Sowohl Xsheet als auch Sheet1 sind zufällige Daten, die nicht sortiert sind.

Was ich versuche zu tun.

Wenn der Name oder die Beschreibung in der Master-Liste (Xsheet) im Datenblatt (Sheet1) zu finden ist und ebenfalls aktiv ist, kopieren Sie ihn ohne Duplikate (mit demselben Code in Sheet2) in ein neues Blatt. Als Teil des Codes hatte der übereinstimmende Name auch die Beschreibung.

Anscheinend sind Duplikate nicht das einzige Problem, das ich hatte, aber ich dachte, ich sollte sie einzeln lösen. Ich erstelle eine neue Frage für das andere Problem, wenn ich keine Antwort auf diese Frage erhielt.

Das ist Xsheet.

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

Dies ist 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 

Das ist 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
Kommentare sind nicht für eine erweiterte Diskussion vorgesehen. Diese Konversation wurde zum Chat verschoben (http://chat.stackexchange.com/rooms/57803/discussion-on-question-by-excelnovice-vba-excel- using-or-column-condition-with). Journeyman Geek vor 6 Jahren 0
@JourneymanGeek Vielen Dank. Ich dachte auch darüber nach, aber damals hatte das OP nicht genug "Punkte", um im Chat zu kommunizieren. ejbytes vor 6 Jahren 0
Vergessen Sie nicht, die Lösung anzunehmen. ejbytes vor 6 Jahren 0

1 Antwort auf die Frage

1
ejbytes

Dies ist der Satz, den Sie beim letzten Mal in meiner Situation zusammengefasst haben.
Msgstr "Wenn der Name oder die Beschreibung in der Hauptliste im Datenblatt gefunden wird und auch aktiv ist, dann kopieren Sie es auf ein neues Blatt."

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 
@ExcelNovice Gern geschehen! ejbytes vor 6 Jahren 0