Herbers Excel-Forum - das Archiv

SUMMEWENN mit VBA, chemische Verbindungen

Bild

Betrifft: SUMMEWENN mit VBA, chemische Verbindungen
von: Wolfgang K.

Geschrieben am: 21.04.2005 08:15:11
Hallo,
Ich scheitere gerade daran, folgende Funktion zu erstellen:
In Spalte A sind chemische Verbindungen aufgelistet, in Spalte B deren Mengen in Mol. Meine Funktion "molsumme(O)" soll nun für alle Verbindungen aus A:A, welche O enthalten, die Werte aus B summieren. Das Problem: Tritt eine Verbingung wie CO2 auf, muss deren Wert aus Spalte B mit 2 multipliziert werden, um den elementaren Wert zu erhalten, bei O3 mit 3 usw.
Mit bestem Dank für jeden Hinweis,
Wolfgang K.
Bild

Betrifft: AW: SUMMEWENN mit VBA, chemische Verbindungen
von: bst

Geschrieben am: 21.04.2005 09:26:18
Morgen Wolfgang,
versuch mal sowas. Funktioniert nur wenn O max. 1 Mal vorkommt, d.h. nicht mit was wie "NO2XOY".
Aufruf via = MolSumme("O")
cu, Bernd
--
Function MolSumme(what As String) As Double
Dim cell As Range
Dim ipos As Integer
Dim myVal As Double
MolSumme = 0
For Each cell In Intersect(ActiveSheet.UsedRange, Range("A:A"))
ipos = InStr(cell.Value, what)
If ipos > 0 Then
myVal = Val(Mid(cell.Value, ipos + Len(what)))
If myVal = 0 Then myVal = 1
MolSumme = MolSumme + myVal * cell.Offset(0, 1).Value
End If
Next
End Function

Bild

Betrifft: AW: SUMMEWENN mit VBA, chemische Verbindungen
von: Wolfgang K.

Geschrieben am: 21.04.2005 10:34:57
Danke vielmals, das ist genau, was ich gesucht habe!
Jetzt hab ich nur gerade ein Problem entdeckt: Summiere ich alle "C", so werden auch z.B. alle "Ca" oder "Cu" summiert. Folgender Lösungsweg ist mir eingefallen: Nur Verbindungen, bei welchen nach dem Suchstring kein Kleinbuchstabe mehr kommt, sind mitzuzählen. Ist das so überhaupt realisierbar?
Danke jedenfalls nochmal,
Wolfgang K.
Bild

Betrifft: AW: SUMMEWENN mit VBA, chemische Verbindungen
von: Waltraud
Geschrieben am: 21.04.2005 10:56:42
es müsste reichen, wenn due diese Zeile weglässt
If myVal = 0 Then myVal = 1
Bild

Betrifft: AW: SUMMEWENN mit VBA, chemische Verbindungen
von: bst

Geschrieben am: 21.04.2005 11:02:05
Nochmals Hallo,
@Waltraud,
nein. Dann zählt er auch in "CO2" keine C's mehr.
@Wolfgang,
das geht schon. Indem man das dem Match folgende Zeichen testet.
Allerdings findet er dann immer noch kein C in was wie "CaCO2". Da er NUR einmal sucht.
Man kommt also hier wohl um eine Schleife nicht drumrum.
Hier ein 2. Versuch.
cu, Bernd
--
Option Explicit
Function MolSumme(what 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(ActiveSheet.UsedRange, Range("A:A"))
ipos = InStr(cell.Value, what)
While ipos > 0
ch = Mid(cell.Value, ipos + 1, 1)
If ch Like "[A-Z]" Then
myVal = 1
ElseIf ch Like "[0-9]" Then
myVal = Val(Mid(cell.Value, ipos + Len(what)))
Else
myVal = 0
End If
MolSumme = MolSumme + myVal * cell.Offset(0, 1).Value
ipos = InStr(ipos + Len(what), cell.Value, what)
Wend
Next
End Function

Bild

Betrifft: AW: SUMMEWENN mit VBA, chemische Verbindungen
von: Wolfgang K.

Geschrieben am: 21.04.2005 12:48:02
Danke, jetzt funktioniert alles perfekt! Bernds zweite Lösung erkennt die Elemente mit zwei Zeichen leider nicht mehr und hat Probleme wenn das Element schon elementar vorliegt. Deshalb noch die zwei kleinen Anpassungen:
Function MolSumme(what 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(ActiveSheet.UsedRange, Range("A:A"))
ipos = InStr(cell.Value, what)
While ipos > 0
If Len(what) = 1 Then
ch = Mid(cell.Value, ipos + 1, 1)
ElseIf Len(what) = 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(what)))
Else
myVal = 1
End If
MolSumme = MolSumme + myVal * cell.Offset(0, 1).Value
ipos = InStr(ipos + Len(what), cell.Value, what)
Wend
Next
End Function

Danke nochmal, das ist echt ein gutes Forum hier!
 Bild
Excel-Beispiele zum Thema "SUMMEWENN mit VBA, chemische Verbindungen"
Beispiel für die Anwendung der SUMMEWENN-FORMEL SUMMEWENN-Funktion über mehrere Tabellenblätter
SummeWenn-Summierung über mehrere Blätter