Parça al fonksiyonunun kod ile yazılması

[mozakay]

ARKADAŞLAR MERHABA,

Bir konuda yardımınıza ihtiyacım var.

sorun şu şekilde;

KAYIT Sayfası "B" sütununa girilen 11 basamaklı bir numarayı
TAKİP Sayfası "B" sütununda aranıyor. Bulunur ise, koşullu biçimlendirme ve
ve msgbox ile "E" sütunundaki karşılığı getiriliyor.

buraya kadar her şey normal. ancak ben bu aramanın 11 basamaklı rakama göre değil de, soldan 2, sağdan 3 rakamının dikkate alınmadan arada kalan 6 basamağa göre yapılmasını istiyorum.

örenek: 25 112614 200

mevcut kullandığım kod şu şekilde;

Private Sub Worksheet_Change(ByVal Target As Range)
'Bobin numarası aramak için


If Intersect(Target, Range("B7:B65536")) Is Nothing Then GoTo 10


Set BUL = Sheets("TAKİP").Range("G:G").Find(Target, , , xlWhole)
If Not BUL Is Nothing Then
End If
With Target
If .Count > 1 Or .Column <> 2 Then Exit Sub
.Font.Color = vbBlack
.Interior.ColorIndex = 2
'.Interior.ColorIndex = xlNone
.Font.Size = 11
.Font.Bold = True
.Font.Italic = False
.Font.Underline = False
If Application.CountIf(Worksheets("TAKİP").Columns(2), .Value) > 0 Then
'.Font.Color = vbGreen
'.Font.Color = vbBlack
'.Font.Color = vbRed
.Font.Color = vbBlack
'.Interior.ColorIndex = 1
.Interior.ColorIndex = 3
.Font.Size = 11
.Font.Bold = True
.Font.Italic = True
.Font.Underline = False
MsgBox Worksheets("TAKİP").Columns(2).Find(.Value).Offset(, 3).Value
End If
End With

 

[PLİNT]

Merhaba
Şöyle denermisiniz?
Yukarıdaki gibi soldan 2. rakamdan sonra boşluk yoksa "4" ü "3" yapınız.
4. karakterden itibaren 6 karakter için: (25 112614 200)

 MsgBox Worksheets("TAKİP").Columns(2).Find(Mid(.Value, [COLOR="Red"]4[/COLOR], 6)).Offset(, 3).Value

Kodlar içindeki "eğersay" içinde:

'....
'...
 .Font.Italic = False
.Font.Underline = False
If Application.CountIf(Worksheets("TAKİP").Columns(2), "*" & Mid(.Value, [COLOR="Red"]4[/COLOR], 6) & "*") > 0 Then
'.Font.Color = vbGreen
'.....
'