VBA-Funktion - Berechnung aktualisieren

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Bittes sehr: Es handelt sich um eine Funktion, die die Molmassen von Elementen und Verbindungen eines Tabellenblattes zusammenzählt. Das Element steht dabei immer in Reihe A, die zugehörige Molmasse in G. Übergeben werden der Tabellenblattname und das Element. Molsumme("Tabelle1";"Fe") soll also "Fe" elementar auch von Verbindungen wie Fe2O3 und Fe3O4 mitzählen. Das Grundgerüst hab ich eh nur mit der hilfe dieses Forums zustande gebracht (mal ein dickes Lob an dieser Stelle!), ich habs dann aber noch verändert und ausgebaut.
Hier die Funktion:
Function MolSumme(Tabellenblatt As String, Element As String) As Double Dim cell As Range Dim ipos As Integer Dim myVal As Double Dim ch As String MolSumme = 0 For Each cell In Intersect(Worksheets(Tabellenblatt).UsedRange, Worksheets(Tabellenblatt).Range("A:A")) ipos = InStr(cell.Value, Element) While ipos > 0 If Len(Element) = 1 Then ch = Mid(cell.Value, ipos + 1, 1) ElseIf Len(Element) = 2 Then ch = Mid(cell.Value, ipos + 2, 1) End If If ch Like "[a-z]" Then myVal = 0 ElseIf ch Like "[0-9]" Then myVal = Val(Mid(cell.Value, ipos + Len(Element))) Else myVal = 1 End If MolSumme = MolSumme + myVal * cell.Offset(0, 6).Value ipos = InStr(ipos + Len(Element), cell.Value, Element) Wend Next Set Ws = Nothing End Function

Hallo Wolfgang,
zu hast da eine Rekursie Funktion - ich weiß nicht ob du das beabsichtigst:


MolSumme = MolSumme + myVal * cell.Offset(0, 6).Value

Der Ausdruck rechts enthält "Molsumme", d.h. hier wird die Funktion nochmal aufgerufen - mich wundert es, dass das überhaupt funktioniert ohne Argumente.
Besser, du nimmst eine Temporäre Variable und übergibst dessen Wert am Schluss:


Function MolSumme(Tabellenblatt As String, Element As String) As Double
Dim cell As Range
Dim ipos As Integer
Dim myVal As Double
Dim ch As String
Dim Tmp As Double
Tmp = 0
For Each cell In Intersect(Worksheets(Tabellenblatt).UsedRange, Worksheets(Tabellenblatt).Range("A:A"))
ipos = InStr(cell.Value, Element)
While ipos > 0
If Len(Element) = 1 Then
ch = Mid(cell.Value, ipos + 1, 1)
ElseIf Len(Element) = 2 Then
ch = Mid(cell.Value, ipos + 2, 1)
End If
If ch Like "[a-z]" Then
myVal = 0
ElseIf ch Like "[0-9]" Then
myVal = Val(Mid(cell.Value, ipos + Len(Element)))
Else
myVal = 1
End If
Tmp = Tmp + myVal * cell.Offset(0, 6).Value
ipos = InStr(ipos + Len(Element), cell.Value, Element)
Wend
Next
Set Ws = Nothing
MolSumme = Tmp
End Function

Jetzt müsste es schneller gehen...
Schau mal was jetzt besser geht und was noch nicht, und melde dich dann wieder.
Gruß Matthias

Beliebteste Forumthreads (12 Monate)

VBA-Funktion - Berechnung aktualisieren

10
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

48 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

VBA-Funktion - Berechnung aktualisieren

10 Beiträge zum Forumthread Beiträge zu diesem Forumthread

48 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

10
Beiträge zum Forumthread

Beiträge zu diesem Forumthread