PDA

Vollständige Version anzeigen : Werte ActiveSheet.Cells


Bire
19.07.2014, 20:26
Hallo VBAler,

ich würde mich nicht als absoluten VBA-Neuling bezeichnen, komme aber immer wieder an meine Grenzen und hoffe auch diesmal Hilfe zu bekommen.

Mein Problem ist folgendes:

Ich möchte eine Spalte durchsuchen und immer wenn die Differenz der zwei letzten Zellen größer ist als 0.01 soll über zweit Spalten zwei Zellen eingefügt werden:

A -------- B
0.01 -- xxx
0.02 -- xxx nichts passiert
0.04 -- xxx nun mus zwischen dieses Zeilen über die Spalten A und B eine Zelle eingefügt werden, da die Diff. 0.04 - 0.01 > 0.01

Folgenden Code habe ich mir überlegt:

Sub einfuegen()

ThisWorkbook.Activate

Sheets("Tabelle1").Activate

For loopi = 1 To 10

delta_x1 = ActiveSheet.Cells(4 + loopi, 1).Value

delta_x2 = ActiveSheet.Cells(5 + loopi, 1).Value

delta_x1 -delta_x2 = deltax


Next loopi

End Sub

Ich würde gerne mit deltax abfragen, falls die Differenz größer als bsp. 0.03 ist, müssen 2 Zellen eingefügt werden usw. Leider läuft der Code nicht durch:
Fehler beim Kompilieren: Sub, Function oder Property erwartet

Kann mir jemand helfen? Ich bin schon am verzweifeln.

Vielen Dank und einen schönen sonnigen Samstag noch.

bire

Hasso
19.07.2014, 21:44
Hallo bire,

was ist denn das für eine Anweisung?delta_x1 -delta_x2 = deltaxSo wäre es korrekt: deltax = delta_x1 - delta_x2

aloys78
20.07.2014, 06:01
Hallo bire,

entsprechend deiner Angaben habe ich den Code ein wenig überarbeitet. Dabei setze ich auf folgende Aussagen (wie ich sie verstanden habe):
- die Wertereihe beginnt in Zeile 5
- verglichen wird immer der Wert in Zelle Ax mit der 2 Zeilen vorhergehenden Zelle A(x-2)
- ist die Differenz > 0,03 dann sind vor Ax 2 Zeilen einzufügen; ist die Differenz aber nur > 0,01 (bis 0,03), dann ist vor Ax nur 1 Zeile einfügen.

Nachstehend mein Code-Vorschlag:
Option Explicit

Sub einfuegen()
Dim loopi As Long 'Nr Suchzeile
Dim j As Long 'Nr Vergleichszeile
Dim delta_x As Single 'Differenz der Vergleichswerte
Dim n As Long 'Anzahl der einzufügenden Zeilen
Dim a As Long 'Index Array
Dim arr() As Long 'Array ainzufügende Zeilen
Dim LoL As Long 'Nr der letzten aktiven Zeile
Const iStart As Long = 5 'Start-Zeile <---- ggf. anpassen

'Sammle Informationen einzufügender Zeilen in Array arr
ThisWorkbook.Activate
Sheets("Tabelle1").Activate
With ActiveSheet
LoL = .Cells(Rows.Count, "A").End(xlUp).Row 'Nr der letzten Daten-Zeile
ReDim arr(1 To LoL - iStart + 1) 'Größe Array = Anzahl Werte-Zeilen
For loopi = iStart + 2 To LoL 'Start mirt 3. Wertezeile
j = loopi - 2 'Zeilen# Vergleichswert
a = loopi - iStart + 1 'StartIndex = 1
delta_x = .Cells(loopi, 1) - .Cells(j, 1) 'Differenz beider Werte
If delta_x > 0.01 Then
n = delta_x * 100 'Differenz als Ganzzahl
If n > 3 Then
arr(a) = 2 '2 Zeilen einfügen
Else
arr(a) = 1 '1 Zeile einfügen
End If
End If
Next loopi

'Einfügen von Leerzeilen entsprechend Angaben in Array
Application.ScreenUpdating = False
For j = UBound(arr) To LBound(arr) Step -1 'Tabelle von rückwärts durcharbeiten
If arr(j) > 0 Then 'es sind zeilen einzufügen
For loopi = 1 To arr(j)
.Rows(j + 4).Insert
Next loopi
End If
Next j
Application.ScreenUpdating = True
End With
End Sub

Gruß
Aloys

Bire
20.07.2014, 09:24
Hallo Hasso, Hallo aloys78,

vielen Dank für die schnelle Antworten.

@ Hasso: Ich bin auch ein Trottel. So einfach kann es gehen.

@aloys78: Vielen Dank für Deinen Code, genau so soll es funktionieren. Ich muss noch ein paar Anpassungen machen. Beisp. können die Differenz beider Werte delta_x auch größer sein als 0.03. Entsprechend müssen dann mehr Zellen eingefügt werden.

Das Ziel ist nachher in die entsprechenden Leerzellen, eine interpolation durchzuführen.

Ich würde mir mal so frech sein und mich bei Problemen nochmals melden.

Also vielen Dank. Super!!!

Beste Grüße

Bire

Bire
20.07.2014, 13:21
Hallo Aloys,

nochmals vielen Dank für die Antwort. Habe jetzt ein bisschen herum gespielt und versucht den Code anzupassen.

Leider bekomme ich es nicht so hin wie gewünscht.

Zum besseren Verständnis, habe ich die Datei angehängt.

Was ich nicht verstanden habe, ist, wie die Tabellen eingefügt werden. Wenn ich "meinen" Code durchlaufen lasse, überspringt er ganze Reihen ohne Zeilen einzufüge, obwohl die Differenz > 0.01 ist.

Habe ich das mit dem Case nicht richtig gemacht?

Könntest Du mir eventuell kurz erläutern, was folgende Befehl macht?

LoL = .Cells(Rows.Count, "A").End(xlUp).Row 'Nr der letzten Daten-Zeile
ReDim arr(1 To LoL - iStart + 1) 'Größe Array = Anzahl Werte-Zeilen

Denn ich möchte im Nachgang Werte in den eingefügten Spalten interpolieren. Dafür benötige ich wiederum die letzte Daten-Zeile (siehe mod_interpolieren in der Excel-Datei).

Ich würde mich über eine Antwort super freuen.

Danke und Grüße

Bire

aloys78
20.07.2014, 16:04
Hallo bire,
Habe ich das mit dem Case nicht richtig gemacht?
Das kann ich im Moment nicht sagen, da ich deine Bedingungen nicht kenne bzw diese von deinem ersten Beitrag abzuweichen scheinen.

Nenne mir doch mal die aktuell einzufügende Zellenzahlen bei den in Frage kommenden Differenzen; dann bringe ich eine neue Code-Version.

Könntest Du mir eventuell kurz erläutern, was folgende Befehl macht?
LoL = .Cells(Rows.Count, "A").End(xlUp).Row 'Nr der letzten Daten-Zeile

Die Nummer der letzten belegten Zelle in Spalte A wird hier ausgehend von der letzten Zeile im Blatt aufsteigend ermittelt.

ReDim arr(1 To LoL - iStart + 1) 'Größe Array = Anzahl Werte-Zeilen

Hiermit wir eine eindimensionale Tabelle zur Ausführungszeit definiert, da erst dann ihre Größe bekannt ist. Diese ist identisch mit der Zahl der belegten Zeilen in Spalte A, nämlich 11 (von Spalte 5 = iStart bis 15 =LoL).

Gruß
Aloys

Bire
20.07.2014, 18:48
Hallo Aloys,

vielen Dank . Werde mir den Code nochmals anschauen.

Beim ersten Mal habe ich mein Problem nicht "richtig" dargestellt, da ich dachte, ich schaffe die Anpassung selbst. Fehlgedacht.

Das Problem ist folgendes:

Ich habe in der Spalte A Werte, die auf 0.01 Schritte interpoliert werden müssen. Deshalb dürfen auch nur Zellen über die Spalten-Paare A&B, ausgeführt werden. Gleichzeitig wird die Spalte B entsprechend interpoliert (allerdings keine gleichmäßigen Schrittweiten (siehe Excel-Datei).

Insgesamt habe ich 10 Spalten-Paare (A&B; C&D; E&F; G&H; I&J; K&L; M&N; O&P; Q&R; S&T) die so vorbereitet werden müssen, das später interpoliert werden kann. Jeweils die erste Spalte eines Spalten-Paares, soll in 0.01 Schritte "aufgebrochen werden.

Danach sollen die Zwischenwerte interpoliert werden. In der Excel-Datei habe ich schon einen Interpolier-Code vorbereitet, der allerdings nicht "dynamisch" ist. Daran arbeite ich noch.

Aus dem Grund, dass das Zellen einfügen über 10 Spalten-Paare durchgeführt werden sollt, benötige ich den Code:

LoL = .Cells(Rows.Count, "A").End(xlUp).Row 'Nr der letzten Daten-Zeile

"Dynamisch" (für die Spalten A, C, E, etc.) damit diese für die Interpolation vorbereitet sind.

Den "Case" benötige ich, da die Abstände der Spalten A, C, E etc. nicht gleich sind und zwischen, den Werten 0.01 und z.B. 0.20 variieren. Im schlimmsten Fall benötige ich als 20 oder "X"-Cases. Je nach dem wie groß der Abstand der zwei hintereinander kommenden Zellen ist. Oder hast Du eine andere Idee, wie das programmiert werden könnte?

Ich hoffe ich habe das Problem diesmal besser erklärt.

Besten Dank für alles. Ich komme einfach nicht weiter.

Guten Sonntag noch.

Bire

aloys78
20.07.2014, 20:10
Hallo Bire,
Beim ersten Mal habe ich mein Problem nicht "richtig" dargestellt, da ich dachte,...
Und die Verwirrung hält an. Denn gerade bezüglich der Schrittweite bei der Interpolation sehe ich noch Widersprüche.
Gleichzeitig wird die Spalte B entsprechend interpoliert (allerdings keine gleichmäßigen Schrittweiten (siehe Excel-Datei).
Jeweils die erste Spalte eines Spalten-Paares, soll in 0.01 Schritte "aufgebrochen werden.
Letzteres kann ich anhand deines Codes und der Tabelle nachvollziehen.

Ich gebe mal wieder, was bei mir angekommen ist:
- Interpolieren heisst, Leerzellen für Sp A&B für eine lückenlose 0,01-Folge einzuziehen. Das bedeutet: es reicht Ax mit A(x-1) zu vergleichen und die Differenz mit 100 zu multiplizieren. Die Differenz mit 1 ergibt dann die Zahl der Leerzellen. Dazu brauche ich dann keine Cases.
- für die übrigen 9 Spaltenpaare ist in gleicher Weise zu verfahren.

Gruß
Aloys

Bire
20.07.2014, 20:46
Hallo Aloys,

erstmal wieder vielen Dank für die Rückmeldung.

ich muss mich wohl klarer ausdrücken. Ich habe nochmal eine angepasste Excel-Datei angehängt).

Ich möchte die Spalte A und B (nachher die weiteren Spalten-Paare) interpolieren. Dafür benötige ich für die Spalten A, C, E, etc. so aufbereitet, wie im Arbeitsblatt Tabelle1 für die ersten Werte angedeutet (gelbe Zellen sind nach dem Makro ersten Makro entstanden).

Das erste Makro, sollte entsprechen dem delta X in Spalte A Zellen über die Spalten-Paare einfügen.

A7 und A8 sind 0.02 auseinander, deshalb muss eine Zelle eingefügt werden.
A8 und A9 sind 0.04 auseinander, deshalb müssen 3 Zellen eingefügt werden.

Entsprechend bei 0.05 --> 4 Zellen, 0.06-->5 Zellen usw. die Zellen dürfen aber nur über ein Spalten-Paar, A&B, C&D, etc. eingefügt werden.

Nachher soll über die leeren Zellen interpoliert werden.

Interpolieren heißt, Leerzellen für Sp A&B für eine lückenlose 0,01-Folge einzuziehen. Das bedeutet: es reicht Ax mit A(x-1) zu vergleichen und die Differenz mit 100 zu multiplizieren. Die Differenz mit 1 ergibt dann die Zahl der Leerzellen. Dazu brauche ich dann keine Cases.

Den Case wollte ich einbauen,da jeweils die erste Spalte der Spalten-Paare angibt, wie viele Zellen eingefügt werden sollen. Der Abstand der bei Dir mit 100 multipliziert wird um eine Ganzzahl zu erhalten, ist ja nicht immer gleich. (siehe dazu die Werte in der Spalte A Arbeitsblatt Tabelle1)

Ich bin wirklich froh, dass Du soviel Geduld mit mir hast. Vielleicht gehe ich das Problem auch ganz falsch an.

Danke für die Hilfe und gute Nacht. Für heute genug VBA.

Beste Grüße Bire

aloys78
21.07.2014, 06:10
Hallo Bire,
Das erste Makro, sollte entsprechen dem delta X in Spalte A Zellen über die Spalten-Paare einfügen.
A7 und A8 sind 0.02 auseinander, deshalb muss eine Zelle eingefügt werden.
A8 und A9 sind 0.04 auseinander, deshalb müssen 3 Zellen eingefügt werden.
Damit bestätigst du meine Aussagen.
Den Case wollte ich einbauen, da jeweils die erste Spalte der Spalten-Paare angibt, wie viele Zellen eingefügt werden sollen.
Bezüglich des 1. Spaltenpaares (siehe auch deine Anmerkung oben) brauchst du kein Case-Verfahren.
Ansonsten stelle mal noch folgendes klar:
- was bedeutet konkret die fett markierte Aussage ?
- außerdem bin ich bisher davon ausgegangen, dass die Differenzen immer positiv sind, da zumindest im 1. Spaltenpaar die Werte aufsteigend sind, im 2. Spaltenpaar wechselt das aber, mal aufsteigend, mal absteigend.

Anbei eine neue Code-Version unter folgenden Voraussetzungen:
- für 1. Spaltenpaar mit aufsteigenden Werten
- ohne Case- Verfahren
- Vergleich A(x) zu A(x-1); Anzahl einzufügender Zellenpaare = Differenz*100 - 1
- vorbereitet für Abarbeitung mehrerer Spaltenpaare.

Option Explicit

Sub einfuegen()
'Version 3 vom 21.07.2014
Dim loopi As Long 'Nr Suchzeile
Dim j As Long 'Nr Vergleichszeile
Dim c As Long 'Spalten#
Dim i As Long 'Schleifenzähler
Dim delta_x As Single 'Differenz der Vergleichswerte
Dim n As Long 'Anzahl der einzufügenden Zeilen
Dim a As Long 'Index Array
Dim arr() As Long 'Array ainzufügende Zeilen
Dim LoL As Long 'Nr der letzten aktiven Zeile
Const iStart As Long = 5 'Start-Zeile '<---- ggf anpassen

'Sammle Informationen einzufügender Zeilen in Array arr
ThisWorkbook.Activate
Sheets("Tabelle1").Activate '<---- Tabellenblatt ggf ändern
With ActiveSheet
For i = 1 To 1 'Spaltenpaare nacheinander verarbeiten: A&B, C&D, E&F, ... 'Anzahl Spaltenpaare ggf ändern
c = i * 2 - 1 'Nr der linken Spalte eines Spaltenpaares
LoL = .Cells(Rows.Count, c).End(xlUp).Row 'Nr der letzten Daten-Zeile
ReDim arr(1 To LoL - iStart + 1) 'Größe Array = Anzahl Werte-Zeilen
For loopi = iStart + 2 To LoL 'Start mirt 3. Wertezeile
j = loopi - 1 'Zeilen# Vergleichswert
a = loopi - iStart + 1 'StartIndex = 1
delta_x = .Cells(loopi, c) - .Cells(j, c) 'Differenz beider Werte
If delta_x > 0.01 Then
n = delta_x * 100 'Differenz als Ganzzahl
arr(a) = n - 1 'Anzahl einzufügender Zellen
End If
Next loopi

'Einfügen von Leerzeilen entsprechend Angaben in Array
Application.ScreenUpdating = False
For j = UBound(arr) To LBound(arr) Step -1 'Tabelle von rückwärts durcharbeiten
If arr(j) > 0 Then 'es sind zeilen einzufügen
loopi = j + 4
.Range(.Cells(loopi, c), .Cells(loopi + arr(j) - 1, c + 1)).Insert Shift:=xlDown 'Zellen einfügen
End If
Next j
Application.ScreenUpdating = True
Next i 'nächstes Spaltenpaar
End With
End Sub


Gruß
Aloys

Bire
21.07.2014, 09:10
Hallo Aloys,

vielen Dank für Deinen Code.

Die fettgedruckte Aussage soll heißen:
Für die Spalten A, C, E etc. habe ich eine vordefinierte Interpolations größe. 0.01. Deshalb werden anhand dieser Spalten, die Zwischenräume eingefügt.

Die Werte ergeben eine geschlossene Elypse. Daher sind die Werte in den Spalten mal auf - bzw. absteigend.
Muss ich gestehen, dass habe ich Dir in der Auferegung vergessen zusagen.

Ich bin gerade in der Arbeit und werde mir heute Abend Deinen Code genauer anschauen.

Ich entschuldige diese ungenauen Erklärungen, was der Code können muss.

Vielen Dank für die Hilfe, alleine würde ich das wohl nicht schaffen.

Beste Grüße

Bire

Bire
21.07.2014, 17:46
Hallo Aloys,

vielen Dank für die Rückmeldung. Ich habe:

Abs(.Cells(loopi, c) - .Cells(j, c))

In den Betrag gesetzt, damit funktioniert Dein Code einwandfrei. Jetzt versuche ich noch rauszufinden, wie ich ihn auf die anderen Zellen beziehen kann.

Danach kommt noch die Interpolation dran. Aber ich werde das zuerst einmal selbst versuchen und mich dann eventuell nochmal melden.

Vielen, vielen Dank.

Beste Grüße

Stephan

Bire
23.07.2014, 19:34
Hallo Aloys,

vielen Dank nochmals für Deinen Code. Ich habe ihn jetzt auf mein Problem angepasst und er läuft!!! Danke!!!

Nun stehe ich vor einem anderen Problem, das ich bisher nicht lösen konnte. Ich möchte nun über die entsandenen Zellen interpolieren. Dafür habe ich folgenden Code erstellt:

Sub FillEmpty_with_trend()

Dim rngSearch As Range
Dim rngCol As Range
Dim rngStart As Range
Dim rngStop As Range
Dim rngBlock As Range
Dim i As Long 'Index Array
Dim LoL_ipQ As Long 'Nr der letzten aktiven Zeile
Const intStart As Long = 7 'Start-Zeile <---- ggf. anpassen


ThisWorkbook.Activate
Sheets("Tabelle1").Activate
With ActiveSheet

For i = 1 To 8


LoL_ipQ = .Cells(Rows.Count, i).End(xlUp).Row

With Range(Cells(i, 7), Cells(i, LoL_ipQ))
.Value = .Offset(0, 0).Value
End With



'Bereich der interpoliert werden soll inkl. Überschrift definieren
Set rngSearch = Range(Cells(i, 6), Cells(i, LoL_ipQ))


'Jede Spalte des Bereiches durchlaufen
For Each rngCol In rngSearch.Columns

'Prüfen ob leere Zellen in der Spalte vorhanden sind
If Application.WorksheetFunction.CountBlank(rngCol) > 0 Then

'Zelle mit Startwert und Endwert definieren
Set rngStart = rngCol.Range(Cells(i, 6).End(xlDown))


Set rngStop = rngCol.Range(Cells(i, 6).Offset(rngCol.Rows.Count + 1, 0).End(xlUp))

'Schleife über den Bereich initialisieren
Do
'Von Startzelle bis nächste ausgefüllte Zelle interpolieren
Range(rngStart, rngStart.End(xlDown)).DataSeries _
Rowcol:=xlColumns, _
Type:=xlLinear, _
Date:=xlDay, _
Trend:=True

'Nächste Zelle mit Startwert definieren
Set rngStart = rngStart.End(xlDown)

'Wenn noch nicht ganz am Ende der Liste, Schleife wiederholen
Loop Until rngStart.Row = rngStop.Row
End If

'Nächste Spalte des Bereiches bearbeiten

Next rngCol

Next i

End With


End Sub

Leider springt er mir bei

Set rngStart = rngCol.Range(Cells(i, 6).End(xlDown))
Set rngStop = rngCol.Range(Cells(i, 6).Offset(rngCol.Rows.Count + 1, 0).End(xlUp))

Mit der Fehlermeldung: Laufzeitfehler 1004 Anwendungs- oder objektdefinierter Fehler raus.

Ich weiß nicht wie ich die meinen rngStart und rngStop dynamisch mittels Cells richtig darstelle.

Hast Du eine Idee?

Ich würde mich über eine kurze Nachricht sehr freuen.

Besten Dank und Grüße

bire

aloys78
23.07.2014, 22:18
Hallo Bire,
Ich würde mich über eine kurze Nachricht sehr freuen.
Ohne Datei und ohne zu wissen, was du konkret erreichen willst, ist es schwer, einen Lösungsvorschlag zu unterbreiten.
Aber ein paar Anmerkungen:
With Range(Cells(i, 7), Cells(i, LoL_ipQ))
.Value = .Offset(0, 0).Value
End With

Hier wird ein Wert durch sich selbst ersetzt.
Set rngStart = rngCol.Range(Cells(i, 6).End(xlDown))
Du koppelst 2 Ranges miteinander; wobei ich nicht weiss, was du eigentlich erreichen willst.

Mein Vorschlag: stelle mal eine Datei zur Verfügung mit der Ausgangssituation und wie das Ergebnis aussehen soll; dann kann man mE qualifierter antworten.

Gruß
Aloys

Bire
24.07.2014, 06:11
Hallo Aloys,

vielen dank für Deine schnele Rückmeldung.

Anbei meine Excel-Datei. Ich möchte über die Spaltenpaare 1-4 (später sind es insgesamt 10) im Arbeitsblatt "Tabelle1" interpolieren.

Ich werde mir heute Abend Deine Kommentare schauen.

Vielen Dank und einen schönen Tag.

Bire

aloys78
24.07.2014, 08:54
Hallo Bire,

Sorry - für mich ich die Tabelle nicht selbsterklärend, und bei der Auswahl geeigneter Interpolationsverfahren sehe ich in mir auch nicht den idealen Ansprechpartner.

Gruß
Aloys

Bire
24.07.2014, 11:57
Hallo Aloys,

ok, alles klar. Dann werde ich weiter probieren.

Ich danke Dir auf jeden Fall für die Hilfe und die Lösungen. Hat mich schon sehr viel weiter gebracht.

Beste Grüße

Bire