Sub Test()
' Haluk - 02/12/2022
Dim NoA As Long, regExp As Object, myStr As String, i As Long
NoA = Range("A" & Rows.Count).End(xlUp).Row
Range("B1:B" & NoA) = ""
Set regExp = CreateObject("VBScript.RegExp")
regExp.IgnoreCase = True
regExp.Global = True...
...End Sub
'
Function getData(data As String)
Dim objRegEx As Object, objMatches As Object
Set objRegEx = CreateObject("VBscript.RegExp")
objRegEx.Global = False
objRegEx.Pattern = "([A-Z]\d{2})"
Set objMatches = objRegEx.Execute(data)
getData = IIf(InStr(1...
...Range("C2:C" & Rows.Count).Font.Bold = False
Range("C2:C" & Rows.Count).Font.Underline = False
With VBA.CreateObject("VBScript.RegExp")
For Each Rng In Range("C2:C" & Cells(Rows.Count, "C").End(3).Row)
For Each My_Pattern In Array("(Adı Soyadı:)", "(Şehir:)")...
...My_Data(X, 1) <> "" Then
Pattern_Array.Add My_Data(X, 1), False
End If
Next
With VBA.CreateObject("VBScript.RegExp")
For Each Rng In Range("A1:A" & Cells(Rows.Count, 1).End(3).Row)
For Each My_Pattern In Pattern_Array.Keys...
Korhan hocam bunu denedim fakat yine aynı. Örneğin b1 deki at kelimesi sadece a1 de renkleniyor.
istediğim sonucu renklendirerek Ekliyorum hocam. Yardımcı olursanız çok sevinirim.
...= False
Range("A:A").Font.Bold = False
Range("A:A").Font.Color = False
With VBA.CreateObject("VBscript.RegExp")
For Each Rng In Range("A1:A" & Cells(Rows.Count, 1).End(3).Row)
If Rng.Offset(, 1).Value <> "" Then
.Pattern = "( " &...
...= False
Range("A:A").Font.Bold = False
Range("A:A").Font.Color = False
With VBA.CreateObject("VBscript.RegExp")
For Each Rng In Range("A1:A" & Cells(Rows.Count, 1).End(3).Row)
If Rng.Offset(, 1).Value <> "" Then
.Pattern = "(" &...
Sub test1()
With CreateObject("Vbscript.Regexp")
.Pattern = "\d"
.Global = True
al = Range("B1").Value
If .Test(al) Then
sut = 4
For Each mtch In .Execute(al)
Cells(1, sut).Value = Val(mtch)
sut = sut + 1...
...modülüne ekleyip deneyebilirsiniz...
Private Sub Worksheet_Change(ByVal Target As Range)
' Haluk - 21/09/2020
Dim myStr As String, regExp As Object, objMatches As Object, xMatch As Object
If Not Intersect(Range("A2:A" & Rows.Count), Target) Is Nothing Then
myStr =...
Aşağıdaki makro A sütunundaki hücrelerde istediğiniz işlemi yapar:
Sub renkle()
Dim RegExp As Object
Set RegExp = CreateObject("VBScript.Regexp")
RegExp.Pattern = "[^0-9]"
RegExp.Global = True
son = Cells(Rows.Count, "A").End(3).Row
For i = 1 To son
For j = 1 To Len(Cells(i, "A"))...
...sayfalar yazıyorsa dikkate alınır ama örneğinizdeki gibi birinde sayfalar diğerinde sayfada yazıyorsa maalesef işe yaramıyor:
Sub fark()
Set regexp = CreateObject("VBscript.RegExp")
regexp.Global = True
regexp.Pattern = "[^ A-Za-zĞÜŞİÖÇığüşöç]"
sonC = Cells(Rows.Count, "C").End(3).Row
sonD...
...mı diye kontrol edilir.
Ek/kök haline göre kontrol etmek için çözüm bulunabilir mi bilmiyorum maalesef, beni çok aşıyor :(
Sub farklar()
Set regexp = CreateObject("VBscript.RegExp")
regexp.Global = True
regexp.Pattern = "[^ A-Za-zĞÜŞİÖÇığüşöç]"
son = Cells(Rows.Count, "C").End(3).Row...
...End If
Next
.Sort
.Reverse
Metin = .ToArray()
With VBA.CreateObject("VBScript.RegExp")
.Global = True
.Pattern = "^[0]*"
For X = 0 To UBound(Metin)
Metin(X) = .Replace(Metin(X), "")...
Bu da "RegExp" ile alternatif olsun..
Kullanıcı tanımlı fonksiyon..
=UNIQUE_WORDS(A2)
Option Explicit
Function UNIQUE_WORDS(My_Range As Range)
Application.Volatile True
With VBA.CreateObject("VBScript.RegExp")
.Pattern = "^(.+)\s*\1$"
.Global = True...
Aşağıdaki makroyu dener misiniz?
Sub buyukharfler()
son = Cells(Rows.Count, "C").End(3).Row
Set regexp = CreateObject("VBscript.RegExp")
regexp.Global = True
regexp.Pattern = "[^ A-ZĞÜŞİÖÇ]"
For i = 2 To son
kelime = ""
veri = Split(regexp.Replace(Cells(i, "C"), ""), " ")
sut = 6...
Sizlere daha iyi bir deneyim sunabilmek icin sitemizde çerez konumlandırmaktayız, web sitemizi kullanmaya devam ettiğinizde çerezler ile toplanan kişisel verileriniz Veri Politikamız / Bilgilendirmelerimizde belirtilen amaçlar ve yöntemlerle mevzuatına uygun olarak kullanılacaktır.