07.06.2020, 13:51
(07.06.2020, 13:32)Case schrieb: [ -> ]Hallo, :19:Hallo Case
so? :21:
Habe dies nun bei mir eingepflegt, aber leider macht er jetzt jedesmal eine neue Datei auf, statt im Ablauf weiter zu arbeiten.
Anbei die Original Datei.
07.06.2020, 13:51
07.06.2020, 14:04
Hallo Stefan, :19:
nun - durch das verändern der With Konstruktion vom Range auf die Tabelle (With Tabelle1) macht das...
... eine Kopie der Tabelle in eine neue Datei. :21:
Was soll denn kopiert werden? Ändere das einfach ab. :21:
nun - durch das verändern der With Konstruktion vom Range auf die Tabelle (With Tabelle1) macht das...
Code:
.Copy... eine Kopie der Tabelle in eine neue Datei. :21:
Was soll denn kopiert werden? Ändere das einfach ab. :21:
07.06.2020, 14:12
(07.06.2020, 14:04)Case schrieb: [ -> ]Hallo Stefan, :19:Es soll die Definierten BMK kopiert werden. Also die Spalte D.
nun - durch das verändern der With Konstruktion vom Range auf die Tabelle (With Tabelle1) macht das...
Code:.Copy
... eine Kopie der Tabelle in eine neue Datei. :21:
Was soll denn kopiert werden? Ändere das einfach ab. :21:
07.06.2020, 14:36
Hallo Stefan, :19:
sollen die Daten nur koipiert werden, oder auch irgendwo eingefügt?
Schreibe die Copy-Zeile so: :21:
sollen die Daten nur koipiert werden, oder auch irgendwo eingefügt?
Schreibe die Copy-Zeile so: :21:
Code:
.Range(.Cells(2, 4), .Cells(lngTMP - 1, 4)).Copy07.06.2020, 14:54
(07.06.2020, 14:36)Es soll alle generiert BMK kopiert werden und dann per Userform ( gibt es schon) in der Tabelle 2 eingefügt werden an entsprechender Stelle.Case schrieb: [ -> ]Hallo Stefan, :19:
sollen die Daten nur koipiert werden, oder auch irgendwo eingefügt?
Schreibe die Copy-Zeile so: :21:
Code:.Range(.Cells(2, 4), .Cells(lngTMP - 1, 4)).Copy
07.06.2020, 15:01
Code:
Sub Zusammenfügen()
[D2:D100] = [if(C2:C100="","",B2:B100&"+" & A2:A100&"-" &C2:C100,)]
End Sub07.06.2020, 18:42
Die ganze Formel lautet im Moment so:
Das zusammen fügen funktioniert soweit. Jetzt sollte es aber noch die Zeile D kopieren, in der was steht, und dann die Userform "Auswahl" öffnen.
Habe das Problem gefunden und konnte es lösen.
Danke euch für die Unterstützung!!
Code:
Sub Zusammenfügen()
Dim lngTMP As Long
With Tabelle1
For lngTMP = 2 To .Cells(.Rows.Count, 1).End(xlUp).Row
.Cells(lngTMP, 4).Value = "'=" & .Cells(lngTMP, 2).Value & "+" & .Cells(lngTMP, 1).Value & vbCrLf & "-" & .Cells(lngTMP, 3).Value
Next lngTMP
Dim letzteZeile As Long
Dim Zeile As Long
letzteZeile = Range("A" & Rows.Count).End(xlUp).Row
For Zeile = letzteZeile To 1 Step -1
If WorksheetFunction.CountIf(Range("D2:A" & Zeile), Range("D" & Zeile)) > 1 Then
ActiveSheet.Unprotect Password:="bfag" 'Entfernt den Blatschutz'
Rows(Zeile).EntireRow.Delete
End If
Next
.Copy
Auswahl.Show
ThisWorkbook.Sheets("Erzeugte BMK").Activate
End With
End SubDas zusammen fügen funktioniert soweit. Jetzt sollte es aber noch die Zeile D kopieren, in der was steht, und dann die Userform "Auswahl" öffnen.
Habe das Problem gefunden und konnte es lösen.
Danke euch für die Unterstützung!!
07.06.2020, 19:26
Habe nun ein anderes Problem entdeckt, was bei der alten Version noch funktioniert hat. Und zwar habe ich bei der alten Version die Funktion gehabt, das er beim zusammenfügen, die doppelten gelöscht hat, das jedes nur einmal zusammen gesetzt wurde.
Dies ist der Grund, da aus der Originaltabelle die Spalten kopiert werden, und da mehrmals die gleiche Bezeichnung vorhanden ist untereinander. Dies wollen wir am Schluss nicht haben, sondern nur einmal. Hoffe ist verständlich so.
Dies ist der Grund, da aus der Originaltabelle die Spalten kopiert werden, und da mehrmals die gleiche Bezeichnung vorhanden ist untereinander. Dies wollen wir am Schluss nicht haben, sondern nur einmal. Hoffe ist verständlich so.
Code:
Sub Zusammenfügen()
Dim lngTMP As Long
With Tabelle1
For lngTMP = 2 To .Cells(.Rows.Count, 1).End(xlUp).Row
.Cells(lngTMP, 4).Value = "'=" & .Cells(lngTMP, 2).Value & "+" & .Cells(lngTMP, 1).Value & vbCrLf & "-" & .Cells(lngTMP, 3).Value
Next lngTMP
Dim letzteZeile As Long
Dim Zeile As Long
letzteZeile = Range("A" & Rows.Count).End(xlUp).Row
For Zeile = letzteZeile To 1 Step -1
If WorksheetFunction.CountIf(Range("D2:A" & Zeile), Range("D" & Zeile)) > 1 Then
Rows(Zeile).EntireRow.Delete
End If
Next
.Range(.Cells(2, 4), .Cells(lngTMP - 1, 4)).Copy
Auswahl.Show
ThisWorkbook.Sheets("Erzeugte BMK").Activate
End With
End Sub07.06.2020, 19:55
In auswahl:
Die andere Code brauchst du gar nicht.
Code:
Private Sub Userform_initialize()
Listbox1.list=[if(C2:C100="","",B2:B100&"+" & A2:A100&"-" &C2:C100)]
End SubDie andere Code brauchst du gar nicht.
07.06.2020, 20:07
(07.06.2020, 19:55)snb schrieb: [ -> ]In auswahl:
Code:Private Sub Userform_initialize()
Listbox1.list=[if(C2:C100="","",B2:B100&"+" & A2:A100&"-" &C2:C100)]
End Sub
Die andere Code brauchst du gar nicht.
Aber so wird doch jedes Zusammengefügt, auch die doppelten? Das möchte ich eben nicht.