Thema: Kommentare auslesen | Herbers Excel-Forum

Guten Abend,
hätte eine Frage an die Experten, wie kann ich mehrzeilige Kommentare per vba auslesen und auch wieder mehrzeilig ausgeben, alles was ich bisher gefunden habe schreibt den Kommentar in eine Zeile, damit kann ich diesen aber nicht bearbeiten, z.b. zahlen addieren..
Für einen entsprechenden Code wäre ich dankbar. - mattenkalle -

Hallo,
so gehts.

Sub test()
Dim meAr
Dim strText$

'Kommentar auslesen in einen String 
strText = Range("B1").Comment.Text

If InStr(strText, Chr(10)) > 0 Then
 meAr = Split(strText, Chr(10))
End If

'ab A2 leer machen für neue Daten (A1= Überschrift) 
Range("A2").Resize(Cells(Rows.Count, 1).End(xlUp).Row + 1).ClearContents

If IsArray(meAr) Then
 Range("A2").Resize(Ubound(meAr) + 1) = Application.Transpose(meAr)
Else
 Range("A2") = strText
End If


End Sub

Gruß Tino

Hallo,

Sub KommentarZurueck()
Dim meAr
Dim strText$

'Bereich mit den Daten 
meAr = Range("A2", Cells(Rows.Count, 1).End(xlUp))

'Text zusammenführen 
If IsArray(meAr) Then
    With Application
        strText = Join(.Transpose(meAr), Chr(10))
    End With
Else
    strText = meAr
End If

'Text in Kommentar schreiben 
Range("B1").Comment.Text Text:=strText


End Sub

Gruß Tino

Hallo Kalle,
mal nur aus Interesse. In 2 Zelle steht ein Mehrzeiliger Text und in der 2 und 3 Zeile stehen Zahlen. Wie addierst Du das?
Tabelle2

	E
21	Zeile1 12 23 Zeile4
22	Zeile1 12 23 Zeile4

Tabellendarstellung in Foren Version 5.1

@ Tino, Hajo,
vielen Dank für Eure Hilfe, klappt prima, @Hajo_Zi, ja, hast schon recht, bei Text und Zahlen, da weiß ich auch nicht weiter, kann man das trennen?

Hallo,
um die Zahlen vom Text zu trennen.

Sub ArTrenneTextZahl(strText$, meAr)
Dim objMatch As Object, objRegEx As Object
Dim A As Long
Set objRegEx = CreateObject("VBScript.RegExp")
 With objRegEx
     .MultiLine = True
     .Global = True
     .IgnoreCase = True
     .Pattern = "[0-9]{1,},?[0-9]{1,}"
     Set objMatch = .Execute(strText)
 End With

 For Each objMatch In objMatch
    strText = Replace(strText, objMatch, Chr(10) & objMatch & Chr(10))
 Next objMatch
 meAr = Split(strText, Chr(10))

End Sub
Sub test()
Dim meAr
Dim strText$
Dim A&
'Kommentar auslesen in einen String 
strText = Range("B1").Comment.Text

If InStr(strText, Chr(10)) > 0 Then
 ArTrenneTextZahl strText, meAr
End If

'ab A2 leer machen für neue Daten (A1= Überschrift) 
Range("A2").Resize(Cells(Rows.Count, 1).End(xlUp).Row + 1).ClearContents


If IsArray(meAr) Then
 Range("A2").Resize(Ubound(meAr) + 1) = Application.Transpose(meAr)
Else
 Range("A2") = strText
End If


End Sub

Gruß Tino

Hallo,
hat nicht so richtig funktioniert,
dass schwierige war wenn z. Bsp. 11,99 und auch 1,9 im Text vorkommt,
dann wurde der Text falsch getrennt.
Hier eine Version die bei mir recht gut funktioniert.
https://www.herber.de/bbs/user/66724.xls
Gruß Tino

Hallo Tino,
vielen dank für deine Mühe, klappt prima!!!, vielen Dank!!!, einen "kleinen" Wunsch hätte ich, ist es möglich die Zahlen und Wörter nicht in einer Spalte sondern nebeneinander in zwei Spalten zu sortieren? Viele Grüße mattenkalle

Hallo,
geht etwas einfacher.
Teste mal.

Enum EnumPattern
 Zahlen_ = 0
 Text_ = 1
End Enum

Sub ArTrenneTextZahl(strText$, meAr, sPattern As EnumPattern)
Dim objMatch As Object, objRegEx As Object
Dim A As Long, AA As Long, tmpAr()
Dim Korrektur As Long
Dim strPattern$

Const sZahlen$ = "[0-9]{1,},?[0-9]{0,}"
Const sText$ = "\D{2,}"

strPattern$ = IIf(sPattern = Text_, sText, sZahlen)

Set objRegEx = CreateObject("VBScript.RegExp")


 With objRegEx
     .MultiLine = True
     .Global = True
     .IgnoreCase = True
     .Pattern = strPattern
     Set objMatch = .Execute(strText)
 End With
 
 If Not objMatch Is Nothing Then
    Redim Preserve tmpAr(objMatch.Count - 1)
    
    For Each objMatch In objMatch
     If IsNumeric(objMatch) Then
       tmpAr(A) = objMatch * 1
     Else
       tmpAr(A) = objMatch
     End If
       A = A + 1
    Next objMatch
 End If
 
 meAr = tmpAr
End Sub

Sub Test_Text_Zahlen_Trennen()
Dim meArText, meArZahlen
Dim strText$
Dim A&
'Kommentar auslesen in einen String 
strText = Range("B1").Comment.Text

If (strText Like "*#*") Then
 ArTrenneTextZahl strText, meArZahlen, Zahlen_
End If

If (strText Like "*[A-Z]*") Then
 ArTrenneTextZahl strText, meArText, Text_
End If

'ab A2 leer machen für neue Daten (A1= Überschrift) 
Range("A2").Resize(Cells(Rows.Count, 1).End(xlUp).Row + 1).ClearContents
Range("B2").Resize(Cells(Rows.Count, 2).End(xlUp).Row + 2).ClearContents

If IsArray(meArText) Then
 Range("A2").Resize(Ubound(meArText) + 1) = Application.Transpose(meArText)
End If

If IsArray(meArZahlen) Then
 Range("B2").Resize(Ubound(meArZahlen) + 1) = Application.Transpose(meArZahlen)
End If
End Sub

Gruß Tino

Hallo Tino,
perfekt, besser gehts nicht, Danke und ein FROHES FEST - mattenkalle -