Hirdetés
- Luck Dragon: Asszociációs játék. :)
- sziku69: Fűzzük össze a szavakat :)
- sziku69: Szólánc.
- koxx: Bloons TD5 - Tower Defense játék
- sh4d0w: StarWars: Felismerés
- Brogyi: CTEK akkumulátor töltő és másolatai
- eBay-es kütyük kis pénzért
- D1Rect: Nagy "hülyétkapokazapróktól" topik
- GoodSpeed: Ebes, a megtervezett falu!
- GoodSpeed: Nem vénnek való vidék - Berettyóújfalu
-
LOGOUT
A Microsoft Excel topic célja segítséget kérni és nyújtani Excellel kapcsolatos problémákra.
Kérdés felvetése előtt olvasd el, ha még nem tetted.
Új hozzászólás Aktív témák
-
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 SubArra 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.
-
Kobe
veterán
válasz
Cilindrik
#37381
üzenetére
Adat - Szovegbol oszlopok
Ott a fuggoleges specko karaktert beadod separatornak es szetszedi (de space alapjan is szetcsapja, csak minden szot kulon oszlooba). Ha az egyszinueket egy oszlopba akarod rakni akkor szetszedes utan raeresstesz egy CONCATENATE fuggvenyt a fekete szoveges oszlopokra, meg egyet a pirosakra
Új hozzászólás Aktív témák
- iPhone 12 Pro 256GB Gold -1 ÉV GARANCIA - Kártyafüggetlen, MS3581, 100% Akksi
- BESZÁMÍTÁS! ASRock B450M R5 2600X 16GB DDR4 512GB SSD GTX 1050Ti 4GB AIGO B352A Chieftec 400W
- ÁRGARANCIA!Épített KomPhone i7 14700KF 32/64GB RAM RTX 5090 32GB GAMER PC termékbeszámítással
- Telefon felvásárlás!! Samsung Galaxy A12/Samsung Galaxy A22/Samsung Galaxy A32/Samsung Galaxy A52
- Lenovo Thunderbolt 3 kábel (4X90U90617)
Állásajánlatok
Cég: PCMENTOR SZERVIZ KFT.
Város: Budapest
Cég: NetGo.hu Kft.
Város: Gödöllő
Fferi50
