Hirdetés
- Most Kína tiltotta ki a nemrég exportengedélyt kapott AI gyorsítókat?
- Bluetooth hangszórók
- Házimozi belépő szinten
- Milyen alaplapot vegyek?
- Milyen videókártyát?
- SSD kibeszélő
- Milyen RAM-ot vegyek?
- Analóg "félklaviatúra" jött a Lemokey (Keychron) színeiben
- AMD GPU-k jövője - amit tudni vélünk
- Xiaomi Pad 6 - kiapadhatatlan jóság
-
PROHARDVER!
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
- Android alkalmazások - szoftver kibeszélő topik
- Most Kína tiltotta ki a nemrég exportengedélyt kapott AI gyorsítókat?
- Kerékpárosok, bringások ide!
- BestBuy topik
- Bluetooth hangszórók
- Házimozi belépő szinten
- Escape from Tarkov
- Greenwashing és zöld sivatag miatt támadják az Apple Watch-ot
- Eredeti játékok OFF topik
- Audi, Cupra, Seat, Skoda, Volkswagen topik
- További aktív témák...
- ROBUX ÁRON ALUL - VÁSÁROLJ ROBLOX ROBUXOT MÉG MA, ELKÉPESZTŐ KEDVEZMÉNNYEL (Bármilyen platformra)
- Játékkulcsok olcsón: Steam, Uplay, GoG, Origin, Xbox, PS stb.
- Játékkulcsok a legjobb áron: Steam
- Bitdefender Total Security 3év/3eszköz! - Tökéletes védelem, Most kedvező áron!
- Számlás!Steam,EA,Epic és egyébb játékok Pc-re vagy XBox!
- Bomba ár! Fujitsu LifeBook U904 - i5-4G I 10GB I 256SSD I 14" QHD+ I HDMI I Cam I W10 I Garancia!
- HATALMAS AKCIÓK! GARANCIA, SZÁMLA - Windows 10 11, Office 2016 2019 2021,2024, vírusírtók, VPN
- Beszámítás! Apple iPad Pro 11 2024 1TB WiFi + Cellular tablet garanciával hibátlan működéssel
- REFURBISHED és ÚJ - Lenovo ThinkPad 40AS USB-C docking station (akár 3x4K felbontás)
- REFURBISHED - HP USB-C Universal Dock G1 docking station (DisplayLink)
Állásajánlatok
Cég: CAMERA-PRO Hungary Kft.
Város: Budapest