Új hozzászólás Aktív témák

• #37397 Fferi50 Topikgazda Cilindrik #37385

  Új Válasz 2018-02-22 14:21:39 #37397

  Új hozzászólás

  Összes hozzászólása itt Válaszok az összes hozzászólására itt Válaszok erre a hozzászólásra

  Privát üzenet küldése

  

  Fferi50

  Topikgazda

  válasz Cilindrik #37385 üzenetére

  Szia!

  Az alábbi makrót írd be egy általános modulba:

  Sub szinvalaszt()
Dim cl As Range, xx As Integer, rang2 As Range, yy As Long
If Selection.Columns.Count > 1 Then
MsgBox "Csak egy oszlopot tudok kezelni, egy oszlopot jelölj ki csak!", vbInformation
Exit Sub
End If
Set rang2 = Selection.Offset(0, 2) ' a kettővel arrébb levő oszlopba fogja tenni az eredményt, ha közvetlenül mellé szeretnéd, akkor Offset(0,1)-et írj.
For Each cl In Selection.Cells
yy = cl.Characters(1, 1).Font.Color
For xx = 1 To cl.Characters.Count
If cl.Characters(xx, 1).Font.Color <> yy Then
rang2.Cells(cl.Row, cl.Column).Value = Left(cl.Text, xx - 1)
rang2.Cells(cl.Row, cl.Column + 1).Value = Mid(cl.Text, xx)
rang2.Cells(cl.Row, cl.Column).Font.Color = yy
rang2.Cells(cl.Row, cl.Column + 1).Font.Color = cl.Characters(xx, 1).Font.Color
Exit For
End If
Next
Next
End Sub

  Arra képes, hogy bármilyen két színnel készült szöveget szétszedjen 2 oszloppal arrébb, az eredeti színek megtartásával.
  Kijelölöd az adott 1 oszlopban levő szöveget, majd elindítod a makrót - fejlesztőeszközök - makrók - inditás.

  Üdv.

Új hozzászólás Aktív témák