Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
600to604
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
600to604
600to604
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

SUMMEWENN mit VBA, chemische Verbindungen

SUMMEWENN mit VBA, chemische Verbindungen
21.04.2005 08:15:11
Wolfgang
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.

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

Betreff
Datum
Anwender
Anzeige
AW: SUMMEWENN mit VBA, chemische Verbindungen
21.04.2005 09:26:18
bst
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

Anzeige
AW: SUMMEWENN mit VBA, chemische Verbindungen
21.04.2005 10:34:57
Wolfgang
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.
AW: SUMMEWENN mit VBA, chemische Verbindungen
21.04.2005 10:56:42
Waltraud
es müsste reichen, wenn due diese Zeile weglässt
If myVal = 0 Then myVal = 1
AW: SUMMEWENN mit VBA, chemische Verbindungen
21.04.2005 11:02:05
bst
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

Anzeige
AW: SUMMEWENN mit VBA, chemische Verbindungen
21.04.2005 12:48:02
Wolfgang
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!
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige