Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1008to1012
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

Zahlen aus aus Text extrahieren und addieren

Zahlen aus aus Text extrahieren und addieren
11.09.2008 16:20:36
Bernd
Hallo,
ich würde gerne aus einer Zelle, die sowohl Zahlen, aber auch Text enthält, die Zahlen "extrahieren" und miteinander addieren. Der Inhalt der Zelle B2 z.B. würde so aussehen:
'+15 Autos;-10 Waschmaschinen;-3 Schränke
Nun möchte ich in Zelle C2 das Ergebnis sehen: 2
Wie könnte das funktioniere?
Gruß
Bernd

9
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Zahlen aus aus Text extrahieren und addieren
11.09.2008 17:00:00
Peter
Hallo Bernd,
versuch es so:

Public Sub Addiere()
Dim Temp_1  As Variant
Dim Temp_2  As Variant
Dim iIndex  As Integer
Dim lZeile  As Long
Dim dSumme  As Double
For lZeile = 2 To 2
dSumme = 0
Temp_1 = Split(Range("B" & lZeile).Value, ";")
For iIndex = 0 To UBound(Temp_1)
Temp_2 = Split(Temp_1(iIndex), " ")
If IsNumeric(Temp_2(0)) Then
dSumme = dSumme + CDbl(Temp_2(0))
End If
Next iIndex
MsgBox "Die Summe ist " & dSumme
Next lZeile
End Sub


Gruß Peter

AW: Zahlen aus aus Text extrahieren und addieren
11.09.2008 20:20:51
Bernd
Hallo,
danke, das klappt wirklich perfekt! Vielleicht noch was als "Nice to have" :
Kann man das so automatisieren, dass bei manuellen Änderungen in den Zellen von Spalte B automatisch die neuen Summen gerechnet werden ohne dass ich das Makro manuell starten muss?
Gruß
Bernd
Anzeige
AW: Zahlen aus aus Text extrahieren und addieren
11.09.2008 21:28:07
Peter
Hallo Bernd,
dann füge das nachfolgende Makro in das betreffende Tabellenblatt
Rechtsklick auf den Tabellenblattreiter
Linksklick auf Code anzeigen
Makro in das sich öffnende Fenster kopieren
mit Schließen-Kreuz schließen
ausprobieren.
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Temp_1  As Variant
Dim Temp_2  As Variant
Dim iIndex  As Integer
Dim lZeile  As Long
Dim dSumme  As Double
If Target.Count = 1 And Target.Column = 2 Then
dSumme = 0
Temp_1 = Split(Target.Value, ";")
For iIndex = 0 To UBound(Temp_1)
Temp_2 = Split(Temp_1(iIndex), " ")
Temp_2(0) = Trim(Temp_2(0))
If IsNumeric(Temp_2(0)) Then
dSumme = dSumme + CDbl(Temp_2(0))
End If
Next iIndex
Range("C" & Target.Row).Value = dSumme
End If
End Sub


Gruß Peter

Anzeige
AW: Zahlen aus aus Text extrahieren und addieren
12.09.2008 10:42:49
Bernd
Hallo Peter,
danke für die Erweiterung, die auch funktioniert! Die Lösung von Chris hat auch seine Reize, vor allem weil da die Syntax, wie man die Zahlen aus dem Text rausliest, nicht so starr ist. Wenn z. B. im text versehentlich mal ein Komma statt Semikolon auftaucht, wird trotzdem addiert. Laesst sich Dein Makro dahingegend nich flexibilisieren bzw. könnte man das Makro von Chris ebenfalls noch so perfektionieren, dass bei Änderungen in Spalte B sofort neu gerechnet wird?
Viele Grüße
Bernd
AW: Zahlen aus aus Text extrahieren und addieren
12.09.2008 13:56:36
Chris
Servus Bernd,
so:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim DatenArray() As Long, MIDArray() As Variant
Dim i As Long, x As Long, summe As Double, z As Long
If Target.Cells.Count > 1 Then Exit Sub
If Target.Column  2 Then Exit Sub
If Target.Column = 2 And Target.Value = "" Then Target.Offset(0, 1) = "": Exit Sub
If Not Intersect(Target, Range("B:B")) Is Nothing Then
For i = 1 To Len(Target)
If IsNumeric(Mid(Target, i, 1)) Then
ReDim Preserve DatenArray(x)
ReDim Preserve MIDArray(x)
DatenArray(x) = i
MIDArray(x) = Mid(Target, i, 1)
x = x + 1
Else
If i > 1 Then
If Mid(Target, i, 1) = "," And IsNumeric(Mid(Target, i - 1, 1)) And IsNumeric(Mid(Target,  _
i + 1, 1)) Then
ReDim Preserve DatenArray(x)
ReDim Preserve MIDArray(x)
DatenArray(x) = i
MIDArray(x) = Mid(Target, i, 1)
x = x + 1
End If
End If
End If
Next i
For i = LBound(DatenArray()) To UBound(DatenArray())
If DatenArray(i) - 1  0 Then
Select Case Mid(Target, DatenArray(i) - 1, 1)
Case "-":
MIDArray(i) = "-" & MIDArray(i)
End Select
End If
Next i
For i = LBound(DatenArray()) + 1 To UBound(DatenArray())
If DatenArray(i) = DatenArray(i - 1) + 1 Then
MIDArray(i) = MIDArray(i - 1) & MIDArray(i)
MIDArray(i - 1) = 0
End If
Next i
For i = LBound(MIDArray()) To UBound(MIDArray())
summe = summe + MIDArray(i)
Next i
Cells(Target.Row, 3) = summe
End If
End Sub


berücksichtigt jetzt auch Kommazahlen, was vorher nicht war.
Gruß
Chris

Anzeige
AW: Zahlen aus aus Text extrahieren und addieren
12.09.2008 15:22:00
Bernd
Hallo Chris,
noch 2 Fragen zu Deiner Lösung:
Wo steuere ich genau die Spalte, die ich berechnen möchte bzw. wie kann ich z.B. definieren, dass ich nur B2:B18 berechnet wird also nicht die ganze Spalte?
Gruß
Bernd
AW: Zahlen aus aus Text extrahieren und addieren
12.09.2008 15:52:00
Chris
Servus Bernd,
If Target.Column 2 Then Exit Sub
If Target.Column = 2 And Target.Value = "" Then Target.Offset(0, 1) = "": Exit Sub
If Not Intersect(Target, Range("B:B")) Is Nothing Then
Für andere Spalten da, wo 2 steht, die Zahl für die anderen Spalten angeben z.B. Spalte H = 8 und B:B dann durch H:H ersetzen.
für B2:B18 das, statt B:B schreiben .
Wenn die Spalte geändert wird, muss auch summe = ... geändert werden, da hier jetzt in C geschriebeb wird.
ambesten hier Target.Offset(0,1) schreiben (nachbarzelle)
Gruß
Chris
Anzeige
Vielen Dank!
15.09.2008 13:10:59
Bernd
Hallo Chris,
besten Dank für die detaillierte Anwort! Ich denke, dass muesste ich hinbekommen, ansonsten melde ich mich nochmal!
Gruß
Bernd
AW: Zahlen aus aus Text extrahieren und addieren
11.09.2008 17:21:11
Chris
Servus,
oder so, wenn das Trennzeichen kein semikolon ist, sondern beliebig:

Sub test()
Dim DatenArray() As Long, MIDArray() As Double
Dim i As Long, x As Long, summe As Double, z As Long, letzte As Long
letzte = Cells(Rows.Count, 2).End(xlUp).Row
For z = 2 To letzte
For i = 1 To Len(Cells(z, 2))
If IsNumeric(Mid(Cells(z, 2), i, 1)) Then
ReDim Preserve DatenArray(x)
ReDim Preserve MIDArray(x)
DatenArray(x) = i
MIDArray(x) = Mid(Cells(z, 2), i, 1)
x = x + 1
End If
Next i
For i = LBound(DatenArray()) To UBound(DatenArray())
'MsgBox DatenArray(i) & " " & MIDArray(i)
Select Case Mid(Cells(z, 2), DatenArray(i) - 1, 1)
Case "-":
MIDArray(i) = "-" & MIDArray(i)
End Select
'MsgBox DatenArray(i) & " " & MIDArray(i)
Next i
For i = LBound(DatenArray()) + 1 To UBound(DatenArray())
If DatenArray(i) = DatenArray(i - 1) + 1 Then
MIDArray(i) = MIDArray(i - 1) & MIDArray(i)
MIDArray(i - 1) = 0
End If
Next i
For i = LBound(MIDArray()) To UBound(MIDArray())
summe = summe + MIDArray(i)
Next i
Cells(z, 3) = summe
summe = 0
x = 0
Next z
End Sub


Das ist für die gesamte Spalte B.
Gruß
chris

Anzeige

345 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige