Live-Forum - Die aktuellen Beiträge
Datum
Titel
29.03.2024 13:14:12
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1040to1044
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

Pos Nr zur richtigen Zeile

Pos Nr zur richtigen Zeile
22.01.2009 21:03:00
Harald
Hallo im Excelforum,
ich habe eine Menge Zeilen in denen die Pos Nr in der falschen Zeile steht.
In der Exceldatei ist mein Problem genauer beschrieben.

Die Datei https://www.herber.de/bbs/user/58698.xls wurde aus Datenschutzgründen gelöscht

vielen Dank für euer Hilfe
mfg
Harald

10
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Pos Nr zur richtigen Zeile
22.01.2009 22:03:00
Harald
Hallo And,
vielen Dank für deine schnelle Lösung sie funzt, einziger Wehrmutstropen ich habe im Text noch Leerzeilen drin.
mfg
Harald
AW: Pos Nr zur richtigen Zeile
22.01.2009 21:43:00
Tino
Hallo,
geht es hiermit?
Sub Test()
Dim Bereich As Range
Dim strText As String
Dim myArea, myAr()
Dim A As Long, B As Long
'Zellbereich 
Set Bereich = Range("G2", Cells(Rows.Count, 7).End(xlUp))
myArea = Bereich

With Application
    
    myArea = .Transpose(myArea)

 
    strText = Join(myArea, "")
    myArea = Split(strText, "Pos")
    Bereich.Value = ""
 
    For A = 1 To Ubound(myArea)
     Redim Preserve myAr(B)
     myAr(B) = "Pos" & myArea(A)
     strText = Left$(myAr(B), 11)
     myAr(B) = Replace(myAr(B), strText, strText & Chr(10))
     B = B + 1
    Next A
 
 Range("G3").Resize(Ubound(myAr)) = .Transpose(myAr)
End With

End Sub


Gruß Tino

Anzeige
AW: Pos Nr zur richtigen Zeile
22.01.2009 22:05:33
Harald
Hallo Tino,
auch dir möchte ich recht herzlich Danken für deine schnelle Antwort, leider kommt es bei deinem Makro zu einer Fehlermeldung Typen nicht verträglich.
mfg
Harald
und wo? habe kein V XP oT.
22.01.2009 22:07:08
Tino
AW: und wo? habe kein V XP oT.
22.01.2009 22:47:00
Tino
Hallo,
so müsste es gehen.
Sub Test()
Dim Bereich As Range
Dim strText As String
Dim myArea, myAr
Dim A As Long, B As Long

'Zellbereich 
Set Bereich = Range("G2", Cells(Rows.Count, 7).End(xlUp))

myArea = Bereich

With Application.WorksheetFunction
    
    myArea = .Transpose(myArea)
    
    strText = Join(myArea, "")
    myArea = Split(strText, "Pos")
    Bereich.Value = ""
    myAr = Bereich
 
    For A = 1 To Ubound(myArea)
     myAr(A, 1) = "Pos" & myArea(A)
     strText = Left$(myAr(A, 1), 11)
     myAr(A, 1) = Replace(myAr(A, 1), strText, strText & Chr(10))
      
      Do While Right$(myAr(A, 1), 1) = Chr(10)
       myAr(A, 1) = Left$(myAr(A, 1), Len(myAr(A, 1)) - 1)
      Loop
     
     B = B + 1
    Next A

 Bereich.Offset(1) = myAr

End With

End Sub


Gruß Tino

Anzeige
AW: und wo? habe kein V XP oT.
22.01.2009 22:58:57
Harald
Hallo Tino,
das Makro läuft jetzt aber es verliert die letzten Zeilen.
mfg
Harald
letzter Versuch
22.01.2009 23:31:00
Tino
Sub Test()
Dim Bereich As Range
Dim strText As String
Dim myArea, myAr
Dim A As Long, B As Long, C As Integer

'Zellbereich 
Set Bereich = Range("G2", Cells(Rows.Count, 7).End(xlUp))

myArea = Bereich

With Application.WorksheetFunction
    
    myArea = .Transpose(myArea)
    
    strText = Join(myArea, "")
    myArea = Split(strText, "Pos")
    Bereich.Value = ""
    myAr = Bereich
 
    For A = 1 To Ubound(myArea)
     myAr(A, 1) = "Pos" & myArea(A)
        C = 8
     Do While IsNumeric(Mid(myAr(A, 1), C, 1)) Or _
                        Mid(myAr(A, 1), C, 1) = "." Or _
                        Mid(myAr(A, 1), C, 1) = " "
        C = C + 1
     Loop
      
      C = C - 1
     
     strText = Left$(myAr(A, 1), C)
     
     myAr(A, 1) = Replace(myAr(A, 1), strText, strText & Chr(10))
      
      Do While Right$(myAr(A, 1), 1) = Chr(10)
       myAr(A, 1) = Left$(myAr(A, 1), Len(myAr(A, 1)) - 1)
      Loop
     
     B = B + 1
    Next A

 Bereich.Offset(1) = myAr

End With

End Sub


Anzeige
AW: letzter Versuch
22.01.2009 23:54:00
Harald
Hallo Tino,
vielen Dank für deine Ausdauer, werde es morgen testen
mfg
Harald

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige