1. Diese Seite verwendet Cookies. Wenn du dich weiterhin auf dieser Seite aufhältst, akzeptierst du unseren Einsatz von Cookies. Weitere Informationen

VBA Schleifen! Dringend Hilfe benötigt!

Dieses Thema im Forum "Visual Basic 6.0, VBA & VBScript" wurde erstellt von LB1308, 17. Juli 2017.

  1. LB1308

    LB1308 Grünschnabel

    Hallo!

    Folgendes möchte ich erreichen:

    Ab Spalte F soll ein je nach Datei in der Größe variierender Zellbereich kopiert werden und daneben wieder eingefügt werden.
    Das klappt schonmal.
    Dann sollen die eingefügten Zeilen aber je mit einem Wert in Spalte D addiert werden.
    Sprich: alle Werte der Zeile 8 sollen mit dem Wert in "F8" addiert werden,
    alle Werte der Zeile 9 mit dem Wert in "F9" usw.
    Das soll bis zur letzten beschrieben Zeile so weiter gehen.
    Momentan sieht es so aus:

    Code (Visual Basic):
    1. Range("F8").Select
    2. Range(Selection, Selection.End(xlToRight)).Select
    3. Selection.Copy
    4.  
    5. ActiveSheet.Cells(8, ActiveSheet.UsedRange.Columns.Count + 2).PasteSpecial
    6.  
    7. For Each Cell In Selection
    8. Cell.Value = Cell.Value + Range("$D$8").Value
    9. Next
    Ich bin für jeden Tip dankbar!!

    Viele Grüße
     
    Zuletzt von einem Moderator bearbeitet: 17. Juli 2017
  2. Yaslaw

    Yaslaw n/a Moderator

    Ein Teil des Makros wurde aufgezeichnet. Scheusslicher Code.
    Weg von .Select! Das verwendet man nicht, gibt nur Chaos.
    Das ist bei dir der Fall. Du rechnest mit allen Werten in .Selection. .Selection ist aber die Quelle sein und nicht das Ziel der Kopierübung!

    Code (Visual Basic):
    1.     Dim ws As Worksheet
    2.     Dim rngStart As Range
    3.     Dim rngSrc As Range
    4.     Dim rngCell As Range
    5.     Dim rngAddition As Range
    6.     Dim colLast As Integer
    7.     Dim colDelta As Integer
    8.  
    9.     Set ws = ActiveSheet
    10.  
    11.     Set rngStart = ws.Range("F8")
    12.     Set rngAddition = ws.Range("D8")
    13.  
    14.     'Letzte Spalte der Zeile ermitteln
    15.    colLast = xlsGetLastColumn(ws.Rows(rngStart.Row))
    16.  
    17.     'QuellRange ermitteln
    18.    Set rngSrc = ws.Range(rngStart, ws.Cells(rngStart.Row, colLast))
    19.  
    20.     'Delta der Spalten berechnen
    21.    colDelta = colLast - rngStart.Column + 2
    22.  
    23.     'Für alle Zellen des QuellRanges
    24.    For Each rngCell In rngSrc
    25.         'Die Zelle um colDelta versetzt berechnen und abfüllen
    26.        rngCell.Offset(0, colDelta).Value = rngCell.Value + rngAddition.Value
    27.     Next
    Nachtrag 18.07.2017 08:49: Scheint wohl doch nicht so dringend, wie im Titel geschrieben.
     
    Zuletzt bearbeitet: 18. Juli 2017
Die Seite wird geladen...