- Samsung Galaxy S24 Ultra - ha működik, ne változtass!
- Motorola Edge 70 - többért kevesebbet
- Yettel topik
- Xiaomi 15 - kicsi telefon nagy energiával
- Samsung Galaxy A54 - türelemjáték
- Milyen hagyományos (nem okos-) telefont vegyek?
- Xiaomi 15T Pro - a téma nincs lezárva
- Hat év támogatást csomagolt fém házba a OnePlus Nord 4
- Az 5 legnagyobb bénázás a mobilpiacon idén
- Megtartotta Európában a 7500 mAh-t az Oppo
-
Mobilarena
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
- hege8888: Retro Kocka Kuckó harmadjára Hódmezővásárhelyen
- Bambu Lab 3D nyomtatók
- NVIDIA GeForce RTX 3060 Ti / 3070 / 3070 Ti (GA104)
- Kerékpárosok, bringások ide!
- Gyúrósok ide!
- Samsung Galaxy S24 Ultra - ha működik, ne változtass!
- Amlogic S905, S912 processzoros készülékek
- Napelem
- Motorola Edge 70 - többért kevesebbet
- Yettel topik
- További aktív témák...
- Kaspersky, BitDefender, Avast és egyéb vírusírtó licencek a legolcsóbban, egyenesen a gyártóktól!
- Játékkulcsok ! : PC Steam, EA App, Ubisoft, Windows és egyéb játékok : (12.20.)
- Windows, Office licencek kedvező áron, egyenesen a Microsoft-tól - Automata kézbesítés utalással is!
- 10 Darab ÚJ PC Játékszoftver
- Windows 10 11 Pro Office 19 21 Pro Plus Retail kulcs 1 PC Mac AKCIÓ! Automatikus 0-24
- Xiaomi Redmi 14C / 4/128GB / Kártyafüggetlen / 12Hó Garancia
- BESZÁMÍTÁS! Sapphire B650M R7 8700F 32GB DDR5 1TB SSD RTX 3070 Ti 8GB Zalman S2 TG EVGA 850W
- GYÖNYÖRŰ iPhone 12 64GB Blue -1 ÉV GARANCIA - Kártyafüggetlen, MS3858
- Honor X6a 128GB, Kártyafüggetlen, 1 Év Garanciával
- Apple iPhone 13 Mini 128 GB Fekete 1 év Garancia Beszámítás Házhozszállítás
Állásajánlatok
Cég: PCMENTOR SZERVIZ KFT.
Város: Budapest
Cég: Laptopszaki Kft.
Város: Budapest
Fferi50

