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

Beiträge aus den Excel-Beispielen zum Thema "SUMMEWENN mit VBA, chemische Verbindungen"