Richtige Kombination

[Stefan87]

Hallo, :19:

so? :21:

Hallo Case

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.

[00202]

Hallo Stefan, :19:

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:

[Stefan87]

Hallo Stefan, :19:

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:

Es soll die Definierten BMK kopiert werden. Also die Spalte D.

[00202]

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

[Stefan87]

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

[snb]

Code:

Sub Zusammenfügen()
  [D2:D100] = [if(C2:C100="","",B2:B100&"+" & A2:A100&"-" &C2:C100,)]
End Sub

[Stefan87]

Die ganze Formel lautet im Moment 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
    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 Sub

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!!

[Stefan87]

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.

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 Sub

[snb]

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.

[Stefan87]

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.