AW: Zelleninhalte mehrmals einfügen
02.11.2014 20:22:05
Renner
Hallo Tom,
danke für die Antwort. Es hat auch super Funktioniert !!!!
Leider kann ich den befehl nicht in mein HauptCode übernehmen. Ich bekomme eine Fehlermeldung für Range. Wiesst du woran es liegt und wie ich den fehler in der zukunft vermeiden kann?
Es ist an die Dim finalrow gebunden, wenn ich die lösche funktioniert der Rest wieder. Natürlich ohne finalrow.
Danke noch mals für deinen Vorschlag.
Dima
Private Sub cb_wiciberechnung_Click()
'Bledet das flattern des Bildschirmes aus
Application.ScreenUpdating = False ' gegen bildschirmflakern
Application.EnableEvents = False
Dim QuelleWB As Workbook, ZielWB As Workbook
Workbooks.Open ("C:\Users...........l 28.10.xlsm") ' Quelle, aus der die Tabelle4 _
kopiert werden soll
Set ZielWB = Workbooks("Heuristik 24.10.xlsm") ' Ziel, Workbook mit diesem Makro
Set QuelleWB = Workbooks("SpecialTool 28.10.xlsm")
' Wariable anlegen für die detailiete Quelle und Zielangaben
Dim QuelleWS As Worksheet, ZielWS As Worksheet
Set QuelleWS = QuelleWB.Worksheets("Auftrag") ' Quelle
Set ZielWS = ZielWB.Worksheets("WITI") ' Ziel
' HIER KOMMT DIE FILTERFUNKTION FÜR DIE QUELLE
'Anlegen einer Variablen zur Umwandlung des TextInhaltes aus der TB_zeit in Datum um. Dies ist _
für die Filterfunktion erforderlich ,wandelt das format in die richtige schreibweise um Tabelle2.Range("A1").Value = CDate(Tabelle2.Range("A1").Value)
Dim Datumwiti As Date
Datumwiti = f_witi.tb_zeit_witi
'Dynamischer Zeilenbereich für das Filtern und das Auslesen
Dim lz As Integer 'lz=letzteZeile
'letzte Zeile bestimmen
With QuelleWS
'letzte Zeile bestimmen
lz = Cells(Rows.Count, "A").End(xlUp).Row
'nach dem Kriterium: Größer als Datumseintrag in Zelle G2 CDbl wandelt explizit den Eintrag in _
eine Dezimalzahl. Excel arbeitet bei Datumsformaten mit Ganz- bzw Nachkommazahlen.
QuelleWS.Range(.Cells(4, 1), .Cells(lz, 19)).AutoFilter Field:=14, Criteria1:=">=" & CDbl( _
Datumwiti) 'UserForm.tb_zeit.Value
'Inaktive auslesen "0"
QuelleWS.Range(.Cells(4, 1), .Cells(lz, 19)).AutoFilter Field:=19, Criteria1:="0"
'Auslesen nach maschinennummer
QuelleWS.Range(.Cells(4, 1), .Cells(lz, 19)).AutoFilter Field:=16, Criteria1:=f_witi. _
tb_maschine_witi
'ZELLEN BEREINIGEN IN DER ZIELDATEI (Dynamisch)
Dim lza As Integer 'lz=letzteZeile
'letzte Zeile bestimmen
With ZielWS
'letzte Zeile bestimmen in der Quellendatei um die alten Daten zu löschen
lza = Cells(Rows.Count, "B").End(xlUp).Row
ZielWS.Range(.Cells(6, 2), .Cells(lza, 6)).ClearContents 'Artikel
ZielWS.Range(.Cells(6, 3), .Cells(lza, 6)).ClearContents 'Benennung
ZielWS.Range(.Cells(6, 30), .Cells(lza, 54)).ClearContents 'Fertigungszeit
ZielWS.Range(.Cells(6, 56), .Cells(lza, 82)).ClearContents 'Fertigstellungszeitpunkt dj
End With
' INHALTE IN DIE ZIELTABELLE EINFÜGEN
' QuelleWS.Cells.Copy ZielWS.Cells(1, 1)Range(Cells(zeile1, spalte), Cells(zeile2, spalte))
QuelleWS.Range(.Cells(5, 1), .Cells(lz, 1)).Copy ZielWS.Cells(6, 2) 'Artikel
'ermittelt die Anzahl der Aufträge für die Matrixgröße
Dim finalrow As Long
With ZielWS
finalrow = Cells(Rows.Count, 2).End(xlUp).Row - 4 'liest die letzte Zeiel aus -5 _
beschriebene Zeilen = Anzahl der Aufträge
QuelleWS.Range(.Cells(5, 2), .Cells(lz, 2)).Copy ZielWS.Cells(6, 3) 'Bennenung
QuelleWS.Range(.Cells(5, 11), .Cells(lz, 11)).Copy 'HIET IST DER FEHLER"RANGE METHODE _
FÜR DAS OBJEKT FEHLGESCHLAGEN"
ZielWS.Range(.Cells(6, 30), .Cells(6, 30 + finalrow)).PasteSpecial ' Fertigungsdauer1
QuelleWS.Range(.Cells(5, 11), .Cells(lz, 11)).Copy ZielWS.Cells(6, 9) ' Fertigungsdauer2
QuelleWS.Range(.Cells(5, 11), .Cells(lz, 11)).Copy ZielWS.Cells(6, 10) ' Fertigungsdauer3
'QuelleWS.Range(.Cells(4, 10), .Cells(lz, 10)).Copy ZielWS.Cells(4, 5) 'Wertigkeit db
QuelleWS.Range(.Cells(5, 17), .Cells(lz, 17)).Copy ZielWS.Cells(6, 12) 'dj1
QuelleWS.Range(.Cells(5, 17), .Cells(lz, 17)).Copy ZielWS.Cells(6, 13) 'dj2
QuelleWS.Range(.Cells(5, 17), .Cells(lz, 17)).Copy ZielWS.Cells(6, 14) 'dj3
QuelleWS.ShowAllData
MsgBox "Es wurden alle Auto-Filter entfernt!", vbOKOnly, " Filter deaktiviert"
' Close ohne die änderung zu speichern savechanges:=False
Workbooks("SpecialTool 28.10.xlsm").Close savechanges:=False
hIER KOMMT DER SOLVER
' Clear any previous Solver settings.
SolverZurücksetzen
SolverOptionen MaxZeit:=100, Iteration:=100, Genauigkeit:=0.000001, LinearVoraussetzen:= _
True, _
NichtNegAnnehm:=True, IterSchritte:=100, Toleranz:=5
' Dim finalrow As Long
'With Worksheets("Tabelle4")
'finalrow = Cells(Rows.Count, 5).End(xlUp).Row - 5
solverOk setcell:=Range("C13"), maxminval:=2, _
bychange:=Range("D4:F6") ' ,Engine:= 2, EngineDesc:="Simplex LP"
' Add the constraint for the model. The only constraint is that the
' number of parts used does not exceed the parts on hand--
SolverAdd CellRef:=Range("$D$4:$F$6"), Relation:=5 'Binäre Variable
'Ganze Zahlen
SolverAdd CellRef:=Range("$D$4:$F$6"), Relation:=4
'Jeder auftrag /Zeile nur ein Mal
SolverAdd CellRef:=Range("$C$4:$C$6"), Relation:=2, _
FormulaText:="1"
'Jeder auftrag /Spalte nur ein Mal
SolverAdd CellRef:=Range("$D$7:$F$7"), Relation:=2, _
FormulaText:="1"
'Zeitüberschreitung 1
SolverAdd CellRef:=Range("$B$10"), Relation:=1, _
FormulaText:="$C$14"
'Zeitüberschreitung 2
SolverAdd CellRef:=Range("$B$11"), Relation:=1, _
FormulaText:="$C$15"
'Zeitüberschreitung 3
SolverAdd CellRef:=Range("$B$12"), Relation:=1, _
FormulaText:="$C$16"
' Show the Solver Results dialog box.
SolverSolve UserFinish:=False
' Finish and keep the final results.
SolverFinish KeepFinal:=1
End With
End With
Application.EnableEvents = True
f_witi.Hide
End Sub