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

Zellinhalte Zahlen und Text extrahieren

Zellinhalte Zahlen und Text extrahieren
29.09.2008 12:55:00
Marky
Hallo Excel Spezialisten !
Ich würde gerne aus zwei nebeneinander stehenden Spalten die Zellinhalte extrahieren.
Die Zellinhalte bestehen aus Zahlen und Text. Die aus den Zellen zu extrahierenden Zahlen und Texte
stehen immer in den Spalten K10 und N10.
Die Zielzellen sind immer beginnend mit B24 für den Text und C24 für die Zahlen
Um das ganze zu veranschulichen hab ich eine mappe generiert.
https://www.herber.de/bbs/user/55717.xls
Hat jemand von euch eine Idee wie man das per VBA realisieren könnte.
LG
Markus

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

Betreff
Datum
Anwender
Anzeige
AW: Zellinhalte Zahlen und Text extrahieren
29.09.2008 13:49:37
fcs
Hallo Markus,
nachfolgende Prozeduren bereiten den den text in den Zellen entsprechend auf.
Die erste Prozedur muss du ann einem Command-Button aus der Symbolleiste "Formular" zuweisen
Gruß
Franz

Private Zeile As Long, wks As Worksheet
Sub TextAufloesen()
Set wks = ActiveSheet
With wks
'altdaten löschen
Zeile = 24
.Range(.Cells(Zeile, 2), .Cells(Zeile, 2).End(xlDown).Offset(0, 1)).ClearContents
'1. Text auflösen
Call textaufbereiten(.Range("K10").Value)
'2. Text auflösen
Call textaufbereiten(.Range("N10").Value)
End With
End Sub
Sub textaufbereiten(strText As String)
Dim strZeile As String, intZeichen As Integer, Pos1 As Integer, Pos2 As Integer
If strText  "" Then
For intZeichen = 1 To Len(strText)
strZeile = ""
'Text einer Zeile einlesen
Do Until Mid(strText, intZeichen, 1) = Chr(10)
strZeile = strZeile & Mid(strText, intZeichen, 1)
intZeichen = intZeichen + 1
If intZeichen = Len(strText) Then Exit Do
Loop
If strZeile  "" Then
'Position 1. Leerzeichen
Pos1 = InStr(1, strZeile, " ")
'Menge auslesen
wks.Cells(Zeile, 3) = CDbl(Left(strZeile, Pos1 - 1))
'Position 2. Leerzeichen
Pos1 = InStr(Pos1 + 1, strZeile, " ")
'Position " ("
Pos2 = InStr(Pos1 + 1, strZeile, " (")
If Pos2 = 0 Then Pos2 = Len(strZeile) + 1
'Stoff auslesen
wks.Cells(Zeile, 2) = Mid(strZeile, Pos1 + 1, Pos2 - Pos1 - 1)
Zeile = Zeile + 1
End If
Next
End If
End Sub


Anzeige
AW: Zellinhalte Zahlen und Text extrahieren
29.09.2008 13:55:00
Chris
Servus,
oder so:

Sub Trenne()
Dim DatenN10 As Variant, Index As Variant, DatenK10 As Variant, x As Long, IndexIndex As  _
Variant
DatenN10 = Range("N10")
DatenK10 = Range("K10")
Index = Split(DatenK10, Chr(10))
x = 24
For i = LBound(Index) To UBound(Index)
IndexIndex = Split(Index(i), " ")
Range("B" & x) = IndexIndex(0)
Range("C" & x) = IndexIndex(2)
x = x + 1
Next i
Index = Split(DatenN10, Chr(10))
For i = LBound(Index) To UBound(Index)
IndexIndex = Split(Index(i), " ")
Range("B" & x) = IndexIndex(0)
Range("C" & x) = IndexIndex(2)
x = x + 1
Next i
End Sub


setzt allerdings voraus, dass deine Daten immer so aufgebaut sind, wie im Beispiel:
Gruß
Chris

Anzeige
AW: Korrektur
29.09.2008 13:59:31
Chris
Servus,
hab die Spalten vetrauscht:
ersetzte:
Range("B" & x) = IndexIndex(0)
Range("C" & x) = IndexIndex(2)
durch:
Range("B" & x) = IndexIndex(2)
Range("C" & x) = IndexIndex(0)
Gruß
Chris
AW: Zellinhalte Zahlen und Text extrahieren
29.09.2008 14:03:01
Tino
Hallo,
hier noch meine Version.
Modul Modul1
Option Explicit 
 
Sub Test() 
Dim strText As String 
Dim arText As Variant 
Dim A As Long 
Dim tempText As String 
strText = Range("K10") & Range("N10") 
arText = Split(strText, ")") 
 
For A = Lbound(arText) To Ubound(arText) - 1 
 tempText = Right$(arText(A), Len(arText(A)) - InStr(arText(A), "kg") - 1) 
 Cells(A + 24, "B") = Trim$(Left$(tempText, InStr(tempText, "(") - 1)) 
 Cells(A + 24, "C") = CDbl(Left(arText(A), InStr(arText(A), " "))) 
Next A 
 
End Sub 


Gruß Tino

Anzeige
AW: Zellinhalte Zahlen und Text extrahieren
30.09.2008 09:37:00
Marky
Hallo Leute !
Vielen, vielen Dank für Eure Mühen.
Die Makros funktionieren wirklich super.
Ihr seit die Besten.
LG
Marky

331 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige