Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen

Zelleninhalte mehrmals einfügen

Betrifft: Zelleninhalte mehrmals einfügen von: Renner
Geschrieben am: 02.11.2014 17:33:07

Hallo alle zusammen.
Da meine VBA Kenntnise sehr gering sind, kann ich folgendes Problem nicht lösen.

Sub Test()
 Dim finalrow As Long
  With ThisWorkbook.Worksheets(2)
   finalrow = Cells(Rows.Count, 2).End(xlUp).Row
 ThisWorkbook.Worksheets(2).Range("A1:A10").Copy.ThisWorkbook Worksheets("Tabelle2").Range( _
Cells(1, 3), Cells(1, finalrow))
End With
End Sub

Ich möchte die Daten aus spalte A kopieren und diese dann mehrmals nebeneinander einfügen. ( Soll eine quadratische Matrix erzeugt werden, brauche ich für spätere Solver Funktion)
Leider kommt die Fehlermeldung "Ausserhalb des gültigen Bereichs" und ich weiss nicht was es ist.
Habt Ihr vielleicht eine Idee wie mein Problem gelöst werde kann.
Danke im Vorraus.
Dima

  

Betrifft: AW: Zelleninhalte mehrmals einfügen von: Crazy Tom
Geschrieben am: 02.11.2014 17:56:24

Hallo

probier es mal so

Option Explicit

Sub Test()
    Dim finalrow As Long
    With ThisWorkbook.Worksheets(2)
        finalrow = .Cells(Rows.Count, 1).End(xlUp).Row
        .Range("A1:A10").Copy
        .Range(.Cells(1, 2), .Cells(1, finalrow)).PasteSpecial
    End With
    Application.CutCopyMode = xlCopy
End Sub

MfG Tom


  

Betrifft: AW: Zelleninhalte mehrmals einfügen von: Renner
Geschrieben am: 02.11.2014 20:22:05

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



  

Betrifft: AW: Zelleninhalte mehrmals einfügen von: Daniel
Geschrieben am: 02.11.2014 22:09:17

Hi

wenn du eine Range über zwei Zellen definierst, dann müssen die beiden Zellen auf dem selben Tabellenblatt liegen wie die Range die sie definieren sollen:

  With ZielWS
  ...  
  QuelleWS.Range(.Cells(5, 11), .Cells(lz, 11)).Copy
durch den Punktk vor den beiden Cells wird das bei WITH definierte Blatt an dieser Stelle eingesetzt und du versuchst die Range auf dem Blatt QuelleWS mit zwei Zellen vom Blatt ZielWS zu erstellen.

je nachdem, welches Blatt du kopieren willst entweder:
  With ZielWS
  ...  
  QuelleWS.Range(QuelleWS.Cells(5, 11), QuelleWS.Cells(lz, 11)).Copy
oder
  With ZielWS
  ...  
  .Range(.Cells(5, 11), .Cells(lz, 11)).Copy
Gruß Daniel


  

Betrifft: AW: Zelleninhalte mehrmals einfügen von: Renner
Geschrieben am: 03.11.2014 13:30:27

Hallo Daniel.
Noch Mal zum richtigen Verstehen. Der Range bezieht sich nur auf das Blatt, welches während des Befehls aktiv ist und da ich erst kopiere und dann einfüge, muss ich jedes Mal den bezug ändern, da ich Ziel und Quelle habe?
Sonst funktioniert der Ausdrcuk 1A
QuelleWS.Range(QuelleWS.Cells(5, 11), QuelleWS.Cells(lz, 11)).Copy ZielWS.Range(.Cells(6, 30), .Cells(6, 30 + Auftragszahl - 1))' Habe Lastwrow in Auftragszahl umbenannt

Eine Frage hätte ich da noch.
Da die Zuördnung dank eurer Hilfe für das Kopeiren funktionier. noch Mal Danke, habe ich diese Vorgehnsweise für den Solver angewand

SolverOptionen MaxZeit:=100, Iteration:=100, Genauigkeit:=0.000001, LinearVoraussetzen:=True, _
NichtNegAnnehm:=True, IterSchritte:=100, Toleranz:=5

solverOk setcell:=Range("CE3"), maxminval:=2, _
bychange:=ZielWS.Range(.Cells(6, 4), .Cells(6 + Auftragszahl - 1, 4 + Auftragszahl - 1))

' Add the constraint for the model. The only constraint is that the

SolverAdd CellRef:=ZielWS.Range(.Cells(6, 4), .Cells(Auftragszahl, 4 + Auftragszahl - 1)), Relation:=5 'Binäre Variable..
Doch hier bekomme ich einen Automatiesierungsfehler.
Warum klappt es in diesem fall nicht. Ich habe doch den Range eindeutig zugeordnet.
Danke


 

Beiträge aus den Excel-Beispielen zum Thema "Zelleninhalte mehrmals einfügen "