Live-Forum - Die aktuellen Beiträge
Datum
Titel
24.04.2024 04:37:43
Mit Word erstellte PDF als Anhang an E-Mail anhängen
24.04.2024 00:20:14
Bestimmte Spalten als xls exportieren per Makro
23.04.2024 22:08:10
Auflisten in Spalte VBA
23.04.2024 21:33:46
Nur farbige/nicht farbige Zellen markieren
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1676to1680
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1676to1680
1676to1680
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Prüfen von Spalte , kopieren von Zeilen

Prüfen von Spalte , kopieren von Zeilen
25.02.2019 18:13:53
Spalte
Hallo zusammen, ich hofe mir kann jemand helfen.
Folgendes:
Ich moechte die Werte von Spalte B in Tabelle 1 mit den Werten in Spalte B in Tabelle 2 vergleichen. Wenn der Wert aus Tabelle 1 nicht enthalten ist, dann die Zeile aus Tabelle 1 in die naechste freie Zeile in Tabelle 2 kopieren. Wenn der Wert enthalten ist, dann die Spalten I-O aus Tabelle 1 in Tabelle 2 updaten.
Alles hilft...;)
Gruss,
Tinchen

22
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: (D)eine Beisp.datei könnte hilfreich sein owT
25.02.2019 18:45:15
neopa
Gruß Werner
.. , - ...
AW: (D)eine Beisp.datei könnte hilfreich sein owT
25.02.2019 18:59:06
Tinchen
Hallo Werner,
hier ein snippet...der aber nicht funktioniert.
Sub kopieren()
Dim lngZeilePO As Variant
Dim lngZeilePO2 As Variant
Dim PO As Variant
Dim PO2 As Variant
With Sheets("Input")
For lngZeilePO = 2 To Range("D" & Rows.Count).End(xlUp).Row
For lngZeilePO2 = 2 To Worksheets("Copy").Range("D" & Rows.Count).End(xlUp).Row
PO = Range("D" & lngZeilePO).Value
PO2 = Worksheets("Copy").Range("D" & lngZeilePO2).Value
If PO  PO2 Then
Worksheets("Input").Rows(lngZeilePO).Copy
Worksheets("Copy").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial  _
xlPasteValues
Application.CutCopyMode = False
Else:
'I-O ueberschreiben
End If
Next
Next
End With
End Sub

Anzeige
AW: offensichtlich VBA-Lösung gesucht ...
25.02.2019 19:20:19
neopa
Hallo Tinchen,
... ich beschäftige mich nicht mit VBA. Unabhängig davon, ein Script ist keine Beispieldatei.
Gruß Werner
.. , - ...
AW: offensichtlich VBA-Lösung gesucht ...
25.02.2019 19:25:53
Tinchen
Ah ok. Aber danke!
Der Script Schnipsel ging jetzt schneller als die ganze Datei. ;)
Tinchen
AW: (D)eine Beisp.datei könnte hilfreich sein owT
25.02.2019 19:44:25
Sepp
Hallo Tinchen,
ungetestet!
Sub kopieren()
  Dim varInput As Variant, varCopy As Variant, lngRow As Long, lngCol As Long

  With Sheets("Input")
    varInput = .Range("A2:O" & .Cells(.Rows.Count, 4).End(xlUp).Row)
  End With

  With Sheets("Copy")
      varCopy = .Range("A2:O" & .Cells(.Rows.Count, 4).End(xlUp).Row)
  End With

  For lngRow = 1 To Ubound(varInput, 1)
    If varInput(lngRow, 2) <> varCopy(lngRow, 2) Then
      For lngCol = 9 To 15
        varCopy(lngRow, lngCol) = varInput(lngRow, lngCol)
      Next
    End If
  Next

  With Sheets("Copy")
    .Range("A2").Resize(Ubound(varCopy, 1), Ubound(varCopy, 2)) = varCopy
  End With
End Sub


VBA/HTML-CodeConverter, AddIn für Office 2002-2016 - in VBA geschrieben von Lukas Mosimann. Projektbetreuung:RMH Software & Media
Code erstellt und getestet in Office 16 - mit VBAHTML 12.6.0

 ABCDEF
1Gruß Sepp
2
3

Anzeige
Hatte einen Denkfehler!
25.02.2019 20:09:44
Sepp
Hallo Tinchen,
vergiss meine vorherige Lösung, ich hatte nicht alles gelesen.
Allerdings immer noch ungetestet!
Sub kopieren()
  Dim varInput As Variant, varCopy As Variant, varFind As Variant, varRet As Variant
  Dim lngRow As Long, lngCol As Long, lngLast As Long

  With Sheets("Input")
    varInput = .Range("A2:O" & .Cells(.Rows.Count, 4).End(xlUp).Row)
  End With

  With Sheets("Copy")
      lngLast = Application.Max(2, .Cells(.Rows.Count, 4).End(xlUp).Row)
      varFind = .Range("B2:B" & lngLast)
      varCopy = .Range("A2:O" & lngLast + Ubound(varInput, 1) + 1)
  End With

  For lngRow = 1 To Ubound(varInput, 1)
    varRet = Application.Match(varInput(lngRow, 2), varFind, 0)
    If IsNumeric(varRet) Then
      For lngCol = 9 To 15
        varCopy(varRet, lngCol) = varInput(varRet, lngCol)
      Next
    Else
      For lngCol = 1 To 15
        varCopy(lngLast, lngCol) = varInput(lngRow, lngCol)
      Next
      lngLast = lngLast + 1
    End If
  Next

  With Sheets("Copy")
    .Range("A2").Resize(Ubound(varCopy, 1), Ubound(varCopy, 2)) = varCopy
  End With
End Sub


VBA/HTML-CodeConverter, AddIn für Office 2002-2016 - in VBA geschrieben von Lukas Mosimann. Projektbetreuung:RMH Software & Media
Code erstellt und getestet in Office 16 - mit VBAHTML 12.6.0

 ABCDEF
1Gruß Sepp
2
3

Anzeige
AW: Hatte einen Denkfehler!
25.02.2019 21:43:22
Tinchen
Hi Sepp,
danke für die große Hilfe. Ich habe es mal ausprobiert. Leider kopiert es nur die erste Zeile und geht dann nicht weiter. Darüber hinaus kopiert es die ganze Spalte neu in das Copy sheet auch wenn es diese Spalte schon gibt.
Was du was das sein könnte?
Gruss,
Tinchen
AW: Hatte einen Denkfehler!
25.02.2019 22:04:27
Sepp
Hallo Tinchen,
glatt noch eine Fehler verbaut ;-)
Sub kopieren()
  Dim varInput As Variant, varCopy As Variant, varFind As Variant, varRet As Variant
  Dim lngRow As Long, lngCol As Long, lngLast As Long

  With Sheets("Input")
    varInput = .Range("A2:O" & .Cells(.Rows.Count, 4).End(xlUp).Row)
  End With

  With Sheets("Copy")
      lngLast = Application.Max(2, .Cells(.Rows.Count, 4).End(xlUp).Row)
      varFind = .Range("B2:B" & lngLast)
      varCopy = .Range("A2:O" & lngLast + Ubound(varInput, 1) + 1)
  End With

  For lngRow = 1 To Ubound(varInput, 1)
    varRet = Application.Match(varInput(lngRow, 2), varFind, 0)
    If IsNumeric(varRet) Then
      For lngCol = 9 To 15
        varCopy(varRet, lngCol) = varInput(lngRow, lngCol)
      Next
    Else
      For lngCol = 1 To 15
        varCopy(lngLast, lngCol) = varInput(lngRow, lngCol)
      Next
      lngLast = lngLast + 1
    End If
  Next

  With Sheets("Copy")
    .Range("A2").Resize(Ubound(varCopy, 1), Ubound(varCopy, 2)) = varCopy
  End With
End Sub


VBA/HTML-CodeConverter, AddIn für Office 2002-2016 - in VBA geschrieben von Lukas Mosimann. Projektbetreuung:RMH Software & Media
Code erstellt und getestet in Office 16 - mit VBAHTML 12.6.0

 ABCDEF
1Gruß Sepp
2
3

Anzeige
AW: Hatte einen Denkfehler!
25.02.2019 22:35:19
Tinchen
Hallo Sepp, Hallo Werner,
leider ist es mir nicht möglich eine Beispiel Datei online zu stellen. DAtei wird mir nicht angezeigt.
@Sepp: Der gleiche Fehler passiert immer noch. Ich seh aber auch nicht den unterschied von deinem 2ten Code zum letzten...
AW: Hatte einen Denkfehler!
25.02.2019 22:45:08
Sepp
Hallo Tinchen,
also ich habe mir selber eine Datei nach deinen Vorgaben erstellt und es werden bei den Vorhandenen Werten die Zeilen aktualisiert und die nicht vorhandenen unten angehängt!
Der Unterschied in den beiden Codes ist nur eine Variable die ich falsch gesetzt hatte.
 ABCDEF
1Gruß Sepp
2
3

Anzeige
AW: Hatte einen Denkfehler!
25.02.2019 22:46:59
Tinchen
Hi Sepp,
mhh komisch. Kannst du mir deine Datei mal schicken? Weis nicht warum ich meine (normale Excel) nicht hochladen kann. Danke!!!
Tinchen
AW: Hatte einen Denkfehler!
25.02.2019 23:00:34
Tinchen
Hallo Sepp,
wenn ich deinen Code in der Original Datei einsetze bekomme ich die Fehlermeldung 9 mit Index ausserhalb des gültigen Bereichs. Die Tabellenblätter sind jedoch alle gekennzeichnet.
Der Debugger bleibt bei bei folgender Codezeile stehen:
varCopy(lngLast, lngCol) = varInput(lngRow, lngCol)
Was kann das sein?
Gruss,
Tinchen
AW: Hatte einen Denkfehler!
25.02.2019 21:57:27
Tinchen
Hi Sepp,
jetzt hatte ich einen Denkfehler...;). Kopiert alles soweit. Jedoch kopiert es eine schon vorhandenen Wert in eine neue Zeile und überschreibt nicht die bisherige.
Weisst du an was das liegt?
Gruss,
Kristin
Anzeige
AW: Hatte einen Denkfehler!
25.02.2019 22:15:36
Werner
Hallo,
liegt vielleicht auch daran, dass du keine Beispielmappe hochladen willst.
Versuch das mal, ist aber auch nur ein Schuss aus der Hüfte. 
Sub Schaltfläche4_Klicken()
Dim letzteQ As Long, letzteZ As Long
Dim wsQ As Worksheet, wsZ As Worksheet
Set wsQ = Worksheets("Input"): Set wsZ = Worksheets("Copy")
Application.ScreenUpdating = False
With wsQ
letzteQ = .Cells(.Rows.Count, 2).End(xlUp).Row
.Range(.Cells(2, 2), .Cells(letzteQ, 15)).Copy _
wsZ.Cells(wsZ.Cells(wsZ.Rows.Count, 2).End(xlUp).Offset(1).Row, 2)
End With
With wsZ
letzteZ = .Cells(.Rows.Count, 2).End(xlUp).Row
.Range(.Cells(2, 16), .Cells(letzteZ, 16)).FormulaLocal = "=ZEILE()"
.Range(.Cells(2, 16), .Cells(letzteZ, 16)).Value = .Range(.Cells(2, 16), _
.Cells(letzteZ, 16)).Value
.Range("B2:P" & letzteZ).Sort Key1:=.Range("P2"), Order1:=xlDescending, Header:=xlNo
.Range("B1:P" & letzteZ).RemoveDuplicates Columns:=1, Header:=xlYes
letzteZ = .Cells(.Rows.Count, 2).End(xlUp).Row
.Range("B2:P" & letzteZ).Sort Key1:=.Range("P2"), Order1:=xlAscending, Header:=xlNo
.Columns(16).ClearContents
End With
Set wsQ = Nothing: Set wsZ = Nothing
End Sub
Gruß Werner
Anzeige
AW: Hatte einen Denkfehler!
25.02.2019 22:45:17
Tinchen
Hi Werner,
gerade ganz vergessen dir zu antworten. Sorry. Danke auch dir für deine tolle Hilfe. Bei dem Code kopiert es auch Spalten in Copy obwohl der Wert in D schon in der Spalte D in Copy vorkommt. Darüber hinaus kopiert es nicht die Spalte A.
Tinchen
AW: Hatte einen Denkfehler!
25.02.2019 23:11:03
Werner
Hallo,
und was kommst du jetzt mit Spalte D ?
Vorher hieß es, Spalte B des einen Blattes abgleichen mit Spalte B der zweiten Blattes.
Zudem schreibst du jetzt etwas von Spalte A, davon war vorher nie die Rede.
Und sorry, nicht Sepp sollte dir eine Datei hochladen, sondern du solltest deine Mappe hochladen.
Voraussetzungen:
Die Mappe darf nicht zu tief in Verzeichnissen "versteckt sein", am besten auf den Desktop legen
Der Name darf keine Umlaute enthalten, am besten in "Test" umbenennen
Die Mappe darf nicht größer als 300 kb sein
Beim Hochladen darauf achten, dass auch die Datenschutzbestimmungen angehakt sind
Die Software erzeugt einen Dateilink, den in deinen Beitrag kopieren
Gruß Werner
Anzeige
AW: Hatte einen Denkfehler!
25.02.2019 23:32:03
Tinchen
Hallo Werner, Hallo Sepp,
hier jetzt doch die Test Datei.
https://www.herber.de/bbs/user/127930.xlsx
Anscheinend hatte ich einen Filter an.
@Werner: Bzgl. der Spalten. Ich hatte ganz am Anfang von B geredet und keine Sheet Namen genannt um es so einfach wie möglich zu halten. In der richtigen Fassung muss in beiden Sheets Spalte D verglichen werden. Mit Spalte A meine ich, dass bei deinem Code alle Spalten bis auf A kopiert werden. Jedoch soll wenn eine Zeile kopiert wird alle Spalten diese Zeile kopiert werden.
Hatte Sepp nach der Datei gefragt, um diese mit meiner Vergleichen zu können und so evtl. den Fehler zu finden.
Ich hoffe das die Datei noch mehr Aufschluss gibt.
Gruss,
Tinchen
AW: Hatte einen Denkfehler!
26.02.2019 00:05:55
Werner
Hallo,
ob es dann so mit den Änderungen passt musst du testen. 
Public Sub Aktualisieren()
Dim letzteQ As Long, letzteZ As Long
Dim wsQ As Worksheet, wsZ As Worksheet
Set wsQ = Worksheets("Input"): Set wsZ = Worksheets("Copy")
Application.ScreenUpdating = False
With wsQ
letzteQ = .Cells(.Rows.Count, 4).End(xlUp).Row
.Range(.Cells(2, 1), .Cells(letzteQ, 15)).Copy
wsZ.Cells(wsZ.Cells(wsZ.Rows.Count, 4).End(xlUp).Offset(1).Row, 1) _
.PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
End With
With wsZ
letzteZ = .Cells(.Rows.Count, 4).End(xlUp).Row
.Range(.Cells(2, 16), .Cells(letzteZ, 16)).FormulaLocal = "=ZEILE()"
.Range(.Cells(2, 16), .Cells(letzteZ, 16)).Value = .Range(.Cells(2, 16), _
.Cells(letzteZ, 16)).Value
.Range("A2:P" & letzteZ).Sort Key1:=.Range("P2"), Order1:=xlDescending, Header:=xlNo
.Range("A1:P" & letzteZ).RemoveDuplicates Columns:=4, Header:=xlYes
letzteZ = .Cells(.Rows.Count, 4).End(xlUp).Row
.Range("A2:P" & letzteZ).Sort Key1:=.Range("P2"), Order1:=xlAscending, Header:=xlNo
.Columns(16).ClearContents
End With
Set wsQ = Nothing: Set wsZ = Nothing
End Sub
Gruß Werner
AW: Hatte einen Denkfehler!
26.02.2019 07:27:22
Tinchen
Guten Morgen Werner,
geil...funktioniert super! ICH DANKE DIR!!!! Das naechste Mal mach ich dann gleich eine Beispiel Datei. ;)
Danke!!!
Gruss,
Tinchen
Gerne u. Danke für die Rückmeldung. o.w.T.
26.02.2019 12:10:36
Werner
AW: Prüfen von Spalte , kopieren von Zeilen
04.03.2019 12:20:08
Spalte
Hallo zusammen,
soweit hat alles gut im Test geklappt. Nun ist im Betrieb aufgefallen, dass
- nicht alle Rows wirklich vom Input Sheet ins Copy sheet uebernommen werden. Leider kann ich hier keine Regel feststellen.
- Das die Daten ihr Format verlieren, wenn sie ins Copy sheet kopiert werden. (Sie sollen aber das Format behalten)
Good to know:
- Im Sheet Input stehen Daten erst ab Zeile 6.
- Die Sub RefreshInput soll nach einem Refresh des Input Sheets die Spalte F in beiden Sheets (Copy, Input) pruefen und wenn gefunden die Spalten I-AB im Input sheet mit den Daten aus dem Copy sheet ueberschreiben. (das heisst das Sub refreshInput ist quasi eine Kopie von Sub kopieren nur andersherum)
- in beiden Subs soll die Spalte F jeweils mit dem anderen Sheet verglichen werden.
Anbei eine Testdatei.
https://www.herber.de/bbs/user/128087.xlsm
Koennt ihr helfen?
Gruss,
Tinchen

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige