-
Fototrend
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
-
Mutt
senior tag
válasz
andreas49
#49005
üzenetére
Szia,
Itt egy makrós változat, amely a KIJELÖLT oszlopon végzi el az átalakítást és mellé írja be a kapott értékeket. Mivel nem írtad hogy mi történjen ha a formátum nem követi az "abc (def) [ghi]" formátumot ezért ahogy nekem logikusnak tűnt írtam meg a kódot. A kommentek alapján próbáld meg módosítani.

Sub Szetszed()
Dim cella As Range
Dim adatsor As Range
Dim pos1 As Long, pos2 As Long, pos3 As Long
Dim text1 As String, text2 As String, text3 As String
'a kijelölt és adatokat tartalmazó tartományt használjuk csak
Set adatsor = Application.Intersect(Selection, ActiveSheet.UsedRange)
'végig megyünk a cellákon
For Each cella In adatsor
text1 = ""
text2 = ""
text3 = ""
'keressük a szövegben a zárójelet
pos1 = InStr(1, cella, "(")
'ha van zárójel akkor a csonkoljuk a szöveget a talált pozícióig
If pos1 > 0 Then
'ha van zárójel akkor a csonkoljuk a szöveget a talált pozícióig
text1 = Trim(Left(cella, pos1 - 1))
'keressük a szögletes árójelet
pos2 = InStr(pos1, cella, "[")
If pos2 > 0 Then
'ha van szögletes, akkor kivesszük a szöveget a zárójel utáni pozíciótól kezdve
text2 = Replace(Trim(Mid(cella, pos1 + 1, pos2 - pos1 - 1)), ")", "")
text3 = Replace(Trim(Mid(cella, pos2 + 1, Len(cella) - pos2)), "]", "")
Else
'nincs szögletes zárójel, de sima volt
pos2 = InStr(pos1, cella, ")")
text2 = Trim(Mid(cella, pos1 + 1, pos2 - pos1 - 1))
text3 = Trim(Mid(cella, pos2 + 1, Len(cella) - pos2))
End If
Else
'nem volt zárójel tartsuk meg az eredeti szöveget
text1 = cella
End If
'eredeti cella melletti oszlopokba írjuk az eredményt
cella.Offset(, 1) = text1
cella.Offset(, 2) = text2
cella.Offset(, 3) = text3
Next cella
End Subüdv
Új hozzászólás Aktív témák
- AMD off topik: VGA, CPU, APU és minden, ami AMD
- Vezeték nélküli fejhallgatók
- Luck Dragon: Asszociációs játék. :)
- Milyen egeret válasszak?
- Ismerkedés a Zyxel NSA325 v2-vel
- Kormányok / autós szimulátorok topikja
- Xbox tulajok OFF topicja
- D1Rect: Nagy "hülyétkapokazapróktól" topik
- Milyen cserélhető objektíves gépet?
- Hosszú premier előzetest kapott az Arknights: Endfield
- További aktív témák...
- Számlás!Steam,EA,Epic és egyébb játékok Pc-re vagy XBox!
- PC Game Pass előfizetés
- Játékkulcsok olcsón: Steam, Uplay, GoG, Origin, Xbox, PS stb.
- Adobe Előfizetések - Adobe Creative Cloud All Apps - 12 Hónap - 15% AKCIÓ
- Game Pass Ultimate előfizetések 1 - 36 hónapig azonnali kézbesítéssel a LEGOLCSÓBBAN! AKCIÓ!
- GYÖNYÖRŰ iPhone 12 mini 128GB Black -1 ÉV GARANCIA - Kártyafüggetlen, MS3878
- ÁRGARANCIA! Épített KomPhone Ultra 7 265KF 32/64GB RAM RTX 5070 12GB GAMER PC termékbeszámítással
- Új Asus Zenbook 14 WUXGA OLED 10bit HDR Ultra7 155H 16mag 32GB 1TB SSD Intel ARC Win11 Garancia
- Huawei Watch Fit 3 Okosóra!
- KÉSZLETKISÖPRÉSI KARÁCSONYI ULTRAAKCIÓ! - MacBook Air M4 16GB 512GB Garancia!
Állásajánlatok
Cég: PCMENTOR SZERVIZ KFT.
Város: Budapest
Cég: Laptopműhely Bt.
Város: Budapest

Fferi50
