PDA

Vollständige Version anzeigen : Suchen und Leerzeile


Michael
04.04.2012, 11:53
Hallo zusammen,
ich habe ein Excelblatt welches durch eine Datenbank gefüllt wird. Das läuft sauber ab.
So jetzt mein Problem.
Beim Import in das Excelsheet geht jedoch die Formatierung des Textes verloren, dass kann ich auch nicht beinflussen.
Ich möchte jetzt folgendes tum. Im dem übergeordneten Tool (DB) trage ich hinter dem letzten Zeichen ein Sonderzeichen "~" ein.
Dieses soll dann gesucht werden -->
bei gefunden
--> Sonderzeichen entfernen
--> Zeilenvorschub/Zeilenabsatz
Es sind mehrere dieses Sonderzeichen in einer Zelle möglich.

Hoffe es kann mir jemand weiterhelfen.
mfg

chris-kaiser
04.04.2012, 14:53
Hi

;)
so??

Sub step_by_step()
Dim rngR As Range, objFound As Object, steps As Integer
Set rngR = ActiveSheet.Columns(1) 'Bereich wo gesucht werden sollte 'anpassen
With rngR
Set objFound = .Find("~~", Lookat:=xlPart)
If Not objFound Is Nothing Then
Do
steps = (Len(objFound) - Len(Replace(objFound, "~", "")))
objFound.InsertIndent steps
objFound = Replace(objFound, "~", "")
Set objFound = .FindNext(objFound)
Loop While Not objFound Is Nothing
End If
End With
End Sub

oder so?

Sub umbruch()
Dim rngR As Range, objFound As Object
Set rngR = ActiveSheet.Columns(3)
With rngR
Set objFound = .Find("~~", Lookat:=xlPart)
If Not objFound Is Nothing Then
Do
objFound = Replace(objFound, "~", Chr(10))
objFound.WrapText = True
Set objFound = .FindNext(objFound)
Loop While Not objFound Is Nothing
End If
End With
End Sub

oder so

Sub chaos()
Dim rngR As Range, objFound As Object, steps As Integer
Set rngR = ActiveSheet.Columns(2) 'Bereich wo gesucht werden sollte 'anpassen
With rngR
Set objFound = .Find("~~", Lookat:=xlPart)
If Not objFound Is Nothing Then
Do
steps = (Len(objFound) - Len(Replace(objFound, "~", "")))
For IntC = 1 To steps
objFound(2, 1).Insert Shift:=xlDown
Next
objFound = Replace(objFound, "~", "")
Set objFound = .FindNext(objFound)
Loop While Not objFound Is Nothing
End If
End With
End Sub

oder.....

;)

Michael
04.04.2012, 15:45
Vielen Dank für die Info.
Das passt im Beispiel zu 100 Prozent.
Wenn ich das in mein Excel übernehmen möchte wird das ganze nicht wie gwollt durchgeführt. Dieses liegt vermutlich am Bereich der durchsucht werden soll.
Ich bin leider nicht der großer Excel King.
Vielleicht kannst du mir dazu weiterhelfen.

Michael

chris-kaiser
04.04.2012, 17:33
Hi

iuiui ;)
das ist ja ein Millimeterpapier ^^

da müsste das reichen

Sub umbruch()
Dim rngR As Range
Set rngR = ActiveSheet.Range("K37")
rngR = Replace(rngR, "~", Chr(10))
End Sub

da ja nur eine Zelle ist.

Michael
04.04.2012, 18:17
Vielen Dank dafür.
Zu guterletzt habe ich dann doch nochmals eine Frage.

"~": kann auch " ~" oder so "~ " ausschauen.
Wie bekomme ich das noch rein.

Mfg,
Michael

chris-kaiser
04.04.2012, 19:24
Hallo Michael

Sub umbruch()
Dim rngR As Range, i As Integer
Dim ar
ar = Array(" ~ ", "~ ", " ~", "~")
Set rngR = ActiveSheet.Range("K37")
For i = 0 To UBound(ar)
rngR = Replace(rngR, ar(i), Chr(10))
Next
End Sub

ich habe noch ein " ~ " miteingepflegt ;)

CitizenX
04.04.2012, 19:34
Hi,

..oder mit Kanonen auf Spatzen ;-)

Sub gofor()
Dim Regex As Object
Set Regex = CreateObject("Vbscript.regexp")

With Regex
.Global = True
.Pattern = " ~| ~ |~|~ "
Range("K37") = .Replace(Range("K37"), Chr(10))
End With

End Sub

Michael
04.04.2012, 20:41
Danke funkt beides.
Aber es fallen mir dann doch von immer noch einige auf.
Wie kann ich am Zeilenanfang noch die Zeichen rausbekommen.
__~test
dann erfolgt der Umbruch und Zeile fängt mit
__ test an.

wie kann ich das noch ändern.
mfg,
Michael

CitizenX
04.04.2012, 21:53
Hi,

teste mal:


Sub gofor()
Dim Regex As Object
Set Regex = CreateObject("Vbscript.regexp")

With Regex
.Global = True
.Pattern = "([ ]{1,})?~([ ]{1,})?"
Range("K37") = .Replace(Range("K37"), Chr(10))
End With

End Sub

Michael
04.04.2012, 22:08
Hallo vielen, vielen Dank, dass läuft perfekt.
Abschliessend doch noch eine Thema, wenn ich nicht nur einen Bereich prüfen will, sondern das ganze "Millimeterpapier" ;), was muss dafür noch eingebaut werden.
Dann wäre das ganze "total perfekt".:)

Sorry ich hab von Excel überhaupt keinen Plan.

michael

CitizenX
04.04.2012, 22:21
Hi,
auf die Schnelle:

Sub gofor()
Dim myRng As Range, myCell As Range
Dim Regex As Object

Set Regex = CreateObject("Vbscript.regexp")
Set myRng = Range("A1:K50") 'dein Bereich -anpassen

With Regex
.Global = True
.Pattern = "([ ]{1,})?~([ ]{1,})?"

For Each myCell In myRng
myCell = .Replace(myCell, Chr(10))
Next
End With

End Sub

Note:
For each Schleife ist nicht grad mein Favorit da nicht grad besonders performant, für kleine Bereiche aber ausreichend.

Wenn's für Größere Bereiche sein soll, meld's dich nochmal..

Michael
04.04.2012, 22:41
Ja es läuft, ist halt schon langsam.
Bei Bereich ist Set myRng = Range("A1:BG100") 'dein Bereich -anpassen

mfg,
Michael

CitizenX
05.04.2012, 09:59
Hi,

dann kombinieren wir chris's Suchroutine mit dem Regex:

Sub umbruch()
Dim rngR As Range, objFound As Object
Dim Regex As Object

Set Regex = CreateObject("Vbscript.regexp")
Set rngR = Range("A1:BG100")
Set objFound = rngR.Find("~~", Lookat:=xlPart)

With Regex
.Global = True
.Pattern = "([ ]{1,})?~([ ]{1,})?"
If Not objFound Is Nothing Then
Do
objFound = .Replace(objFound, Chr(10))
Set objFound = rngR.FindNext(objFound)
Loop While Not objFound Is Nothing
End If
End With
End Sub

Michael
05.04.2012, 12:53
Vielen, vielen Dank. Es läuft jetzt perfekt.

Michael