Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1524to1528
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Per Makro zugehörige Werte finden

Per Makro zugehörige Werte finden
15.11.2016 14:53:23
Florian
Hallo Zusammen,
Ich habe folgendes Problem,
Ich habe 2 Wertelisten:
Werteliste 1(Tabellenblatt 1):
Spalte A: Datum
Spalte B: Laufzeit/h
Spalte C: Kraft/kN
Spalte D: Höhenänderung/%
Spalte E: Innentemperatur/°C
Spalte F: Außentemperatur/°C
Werteliste 2 (Tabellenblatt 2):
Spalte A: Laufzeit/h
Spalte B: Innentemperatur/°C
Spalte C: Höhenänderung_Korrektur/%
Ich muss nun den Wert Höhenänderung(Werteliste1|SpalteD) bei der Temperatur(Werteliste1|SpalteE) um den Wert Höhenänderung_Korrektur(Werteliste1|SpalteC)korrigieren.
D.h. Höhenänderung(Werteliste1|SpalteD)_Temp - Höhenänderung_Korrektur(Werteliste1|SpalteC)_Temp
Da die Werte der beiden Wertelisten nicht immer bei exakt der gleichen Temperatur vorliegen, muss ich den entsprechnden Wert aus der Werteliste 2 interpolieren.
Dazu wollte ich mir zu einer Innentemperatur(Werteliste1|SpalteE) den nächst niedrigeren Wert aus und den nächst höheren Wert aus Werteliste 2 Spalte B suchen und mittels Geradengleichung den zwischenwert berechnen.
Um die Werte zu suchen, habe ich an folgendes Makro gedacht:
Sub grossklein()
Dim lzeile As Long
Dim dklein As Double
Dim dgross As Double
Dim letztezeile As Long
letztezeile = Sheets(1).UsedRange.SpecialCells(xlCellTypeLastCell).Row
MsgBox letztezeile
With ThisWorkbook.Worksheets("Tabelle1")
For j = 1 To 3388
If Trim(.Range("F" & j).Value)  "" Then
If IsNumeric(.Range("F" & j).Value) Then
For lzeile = 2 To 4000
If CDbl(.Range("F" & j).Value) >= CDbl(Worksheets("Korrektur-Werte").Cells(  _
_
lzeile, 2).Value) Then
dklein = CDbl(Worksheets("Korrektur-Werte").Cells(lzeile, 2).Value)
End If
If CDbl(.Range("F" & j).Value) 
Das funktioniert auch, allerdings stürzt Excel (ich denke auf Grund der vielen Datensätze) ab.
Weiß jemand einen einfacheren Weg, bzw. einen Weg, bei dem Excel nicht überfordert ist?
Besten Dank! Schon mal,
Gruß
Florian Rave

5
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
läßt sich schon optimieren-Beispieldatei?
15.11.2016 15:47:19
Michael
Hi Rave,
da geht immer was, aber ohne Beispieldatei mit je ein paar 100 Datensätzen ist das zu viel Gefummel.
Schöne Grüße,
Michael
ist gar nicht so ohne
15.11.2016 22:50:49
Michael
Hi Flo,
zum Glück hat mich die Geschichte gereizt...
Anbei Datei: https://www.herber.de/bbs/user/109454.xlsm
Das Makro gibt in Spalte G die Dehnung aus, in Spalte H den daraus errechneten Wert für die Korrektur.
Mit "Basiskenntnissen" wird es Dir einigermaßen schwer fallen, den Code zu verstehen - dafür läuft er sauschnell.
Schöne Grüße,
Michael
Anzeige
AW: ist gar nicht so ohne
16.11.2016 13:21:51
Florian
Hi Michael,
erstmal vielen Dank für Deine Mühe.
Es stimmt, mit meinen Basiskenntnissen, komme ich nicht dahinter, was Du da veranstaltet hast.
Leider auch nicht so ganz was jetzt in welcher Spalte steht (K-P) ...
Aber es funktioniert und dafür bin ich Dir nochmals sehr dankbar...
Ich gehe davon aus, das ein "?" heißt, hier habe "ich" keinen passenden Wert gefunden?
Gruß
Florian
AW: ist gar nicht so ohne
16.11.2016 16:41:57
Michael
Hi Florian,
freut mich, wenn's geht. Gestern bin ich einige Stunden drangesessen an dem Ding: eigentlich viel zu viel für einen kostenlosen Forumsbeitrag...
Na gut, der Punkt ist, daß "ich" zwischendrin mal sortieren muß, und dafür benutze ich die Spalten ab K.
Das Makro arbeitet so:
a) alle Werte von Tabelle1!Spalte F werden in ein "Dictionary" gesteckt.
Das kann man ähnlich wie "Duplikate entfernen" einsetzen. Du hast ja 3300 Datensätze, davon sind aber sehr viele doppelt: die fliegen erst mal raus.
b) alle Korrektur-Werte aus der zweiten Tabelle!Spalte B kommen in ein Array und werden so nachbearbeitet, daß sie "handlich" sind.
Das ist diese Schleife:
j = 0
t = b(1, 1): k = b(1, 2)
For i = 2 To UBound(b)  ' ohne die unterste Zeile
If b(i, 2)  b(i - 1, 2) Then
j = j + 1
b(j, 1) = t
b(j, 2) = k
b(j, 3) = b(i - 1, 1)
If j > 1 Then b(j - 1, 5) = k: b(j - 1, 4) = t
t = b(i, 1)
k = b(i, 2)
End If
Next

aa) die bereinigten Werte aus F, also das Dictionary, kommt in Spalte L, während K mit dem Kennzeichen "T" (wie Tabelle1) und M mit einem "?" aufgefüllt wird.
bb) das Array aus b) kommt direkt darunter, allerdings in K mit dem Kennzeichen "K" (wie Korrektur) versehen.
c) die Tabelle wird nach Spalte L, also der Temperatur, sortiert. Das sieht dann so aus:
Userbild
Das hier zu sehende, erste "K" in L13 mit 26,3 ist die niedrigste Temperatur in der K-Tabelle (d.h. vorgehende "T"-Werte sind nicht interpolierbar).
In M13 steht die "Dehnung", in N13 der Bereich bis zur nächsten K-Temperatur, solange die Dehnung identisch ist. In N13 sind das wiederum 26,3 Grad, d.h. die Dehnung bei der nächsten K-Temperatur ist anders.
In Zeile 15 verhält es sich so, daß die Dehnung (in M15) unverändert bei allen Temperaturen zwischen 26,6 und 28,7 ist (L15 = 26,6, N15 = 28,7). Das verdeutlichen die blauen Striche von L nach M.
Weiterhin kopiert die obige Schleife den Beginn der jeweils nächsten Grenze samt Wert in die aktuelle Zeile. Das verdeutlichen die roten Striche: O13 enthält eine Kopie des Wertes von L15, P13 von M15.
Warum? Weil das Makro nachher von oben nach unten läuft, und *manchmal* benötigt es für die Interpolation bereits die Werte vom NÄCHSTEN K.
d) die nächsten Schritte habe quasi nach "aufsteigendem Schwierigkeitsgrad" programmiert; siehe:
Userbild
d1) Prüfung, ob T überhaupt in K vorhanden: verdeutlicht mit blauem "Haken" bis Zeile 12: die erste K-Temperatur ist 26,3, alle Ts liegen darunter. Ähnlich ist es am unteren Ende der Tabelle.
Das "?" bleibt stehen, in Spalte O landet das Kennzeichen "XM" (x wie: bearbeitet, M wie kleiner Min bzw. größer Max).
d2) K = T: gelb markiert: die Dehnung aus M13 wird in M14 übernommen, das Kennzeichen "XG" (g wie gleich) gesetzt.
d3) die T-Temperaturen liegen zwischen der Ober-und Untergrenze mit gleicher Dehnung, also: L16 .. L20 ist jeweils größer L15 und kleiner N15: die Dehnung wird aus M15 übernommen.
Roter Bereich; analog Zeilen 21 bis 26; Kennzeichen "X2"
d4) die T-Temperaturen liegen zwischen Obergrenze dieses und der Untergrenze des nächsten K-Bereichs, die ja in "diesen" kopiert wurde: verdeutlicht mit schwarzem Strich.
Die Dehnung in N21 = 30,4 liegt bei M21=0,002, in O21 (=K28) =30,6 bei P21 (=M28) =0,003.
Das Ergebnis der Interpolation landet in M27: 30,5 liegt in der Mitte von 30,4 und 30,6, so daß das Ergebnis (natürlich nur in diesem Fall, wo die Zahlen so schön passen) dem Mittelwert ais 0,002 und 0,003, nämlich ca. 0,0025 entspricht.
Das rechnet die Makro-Zeile
b(i, 3) = b(j, 3) + (b(i, 2) - b(j, 4)) * (b(j, 6) - b(j, 3)) / (b(j, 5) - b(j, 4))

Als Kennzeichen wir "XI" (i wie interpoliert) gesetzt.
e) danach werden alle "T"-Werte wieder in ein "neues" Dictionary gelesen und
f) damit eine Array-Kopie der Spalte F mit den ermittelten Dehnungswerten bestückt und in Spalte G
geschrieben.
g) zuletzt wird diese Kopie noch einmal mit den Formeln durchgerechnet, die aus Temperatur und Dehnung den Korrekturwert ermitteln: das Ergebnis kommt in Spalte H.
Die Berechnung:
f1 = 0.82 / 980
f20 = f1 * 20
' und dann in der Schleife:
b(i, 1) = spF(i, 1) + b(i, 1) * f1 - f20
So weit die Logik.
Im Wesentlichen wurden zwei Programmiertechniken eingesetzt:
Arrays; siehe u.a.: http://www.online-excel.de/excel/singsel_vba.php?f=152
Dictionary: http://www.snb-vba.eu/VBA_Dictionary_en.html
Gerade in e) kommt ein weiterer Vorteil des Dict. zum Zug: der rasend schnelle Zugriff; mit Zellen oder Arrays müßte man alle mit allen Temperaturen vergleichen, bei Dict. sagt man einfach: gib mir den Wert zur Temperatur x: das Dict. muß intern natürlich auch "irgendwie" vergleichen, aber das ist halt optimiert.
Schöne Grüße,
Michael
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige