Hirdetés
- Elektromos rásegítésű kerékpárok
- ricsi99: 6. Genes alaplap tündöklése kontra MS/Zintel korlátozásai
- Luck Dragon: Asszociációs játék. :)
- Brogyi: CTEK akkumulátor töltő és másolatai
- D1Rect: Nagy "hülyétkapokazapróktól" topik
- sziku69: Szólánc.
- Parci: Milyen mosógépet vegyek?
- sziku69: Fűzzük össze a szavakat :)
- gban: Ingyen kellene, de tegnapra
- gerner1
-
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
-
válasz
Delila_1
#35525
üzenetére
Használatra példák:
=RegExExtract(A1)- kiszedi a valamelyik nyitó ([{ és valamelyik záró )]} közül a szöveget=RegExExtract(A1,"","@")- kiszedi az emailcím elejéről a nevet=RegExExtract(A1,"@","")- kiszedi az emailcím végéről a szervert=RegExExtract(A1,"[","]", True)- kiszedi a szögletes zárójeles szöveget (úgy hogy a zárójelet is visszaadja)RegExExtract.bas
Option Explicit
Dim rx As Object
Const REPLACABLE = "()[]{}-+*.\"
Public Function RegExExtract(Text As String, Optional StartMarker As String = "([{", Optional EndMarker As String = "}])", Optional Include As Boolean = False) As String
Dim sm As String
sm = ""
If StartMarker <> "" Then
Dim ix
For ix = 1 To Len(StartMarker)
If InStr(REPLACABLE, Mid(StartMarker, ix, 1)) > 0 Then
sm = sm & "\" & Mid(StartMarker, ix, 1)
Else
sm = sm & Mid(StartMarker, ix, 1)
End If
Next
sm = "[" & sm & "]"
End If
Dim em As String
Dim im As String
em = ""
im = ""
If EndMarker <> "" Then
For ix = 1 To Len(EndMarker)
If InStr(REPLACABLE, Mid(EndMarker, ix, 1)) > 0 Then
em = em & "\" & Mid(EndMarker, ix, 1)
Else
em = em & Mid(EndMarker, ix, 1)
End If
Next
im = "[^" & em & "]*"
em = "[" & em & "]"
Else
im = ".*"
End If
Dim rxt As String
If Include Then
rxt = "(" & sm & im & em & ")"
Else
rxt = sm & "(" & im & ")" & em
End If
If rx Is Nothing Then
Set rx = CreateObject("vbscript.regexp")
rx.IgnoreCase = True
rx.Global = True
rx.MultiLine = True
rx.Pattern = rxt
ElseIf rx.Pattern = rxt Then
'cached
Else
rx.Pattern = rxt
End If
Dim Matches
Set Matches = rx.Execute(Text)
If Matches.Count > 0 Then
Dim M
For Each M In Matches.Item(0).SubMatches
If M <> "" Then
RegExExtract = M
Exit For
End If
Next
Else
RegExExtract = ""
End If
End Function
Új hozzászólás Aktív témák
- Okos otthon - Home Assistant, openHAB és más nyílt rendszerek
- Milyen RAM-ot vegyek?
- Xiaomi 17 Ultra - jó az optikája
- Fotók, videók mobillal
- Debrecen és környéke adok-veszek-beszélgetek
- Vivo X300 Ultra - tárcsázz, ha van rá keret!
- Mesterséges intelligencia topik
- Melyik hordozható audiolejátszót (DAP, MP3, stb.) vegyem?
- Poco X8 Pro Max - nem kell ide sem bank, sem akkubank
- Youtube Android alkalmazás alternatívák reklámszűréssel / videók letöltése
- További aktív témák...
- PC Szervizeket, Gépépítőket keresek B2B szoftver partnerségre (E-számlával)
- Vírusirtó, Antivirus, VPN kulcsok GARANCIÁVAL!
- Játékkulcsok ! : PC Steam, EA App, Ubisoft, Windows és egyéb játékok
- HP. Laptop. i5. Model: 15-da1002nq
- Windows, Office licencek kedvező áron, egyenesen a Microsoft-tól - Automata kézbesítés utalással is!
- Arris VIP7100 Android TV 4K
- Huawei Nova 10 128GB Starry Silver Újszerű állapot 2028. 03. 20. garancia
- Bomba Ár! Panasonic ToughBook FZ55-2 - i5-11GEN I 8GB I 256SSD I 14" HD I 4G WWAN I W11 I Garancia!
- PlayStation 5 Slim (lemezes) + kontroller 2027.12.23-ig garancia, számlával!
- Honor Pad 9 Snapdragon 6 Gen 1 (2024) 8GB/128GB szép állapot
Állásajánlatok
Cég: Laptopműhely Bt.
Város: Budapest
Fferi50