- Katılım
- 31 Aralık 2009
- Mesajlar
- 1,105
- Excel Vers. ve Dili
- excel 2007 türkçe
Excel Vers. ve Dili Ofis 2003
Sub TipBul()
Dim a, _
i As Long, _
j As Integer, _
k As Integer
a = Array("avi", "mpg", "srt")
Application.ScreenUpdating = False
Range("B:C").ClearContents
For i = 1 To Cells(Rows.Count, "A").End(3).Row
For j = 0 To UBound(a)
k = InStr(1, Trim(Cells(i, "A")), a(j), vbTextCompare)
If Not k = 0 Then
If k < (Len(Cells(i, "A")) - Len(a(j)) - 1) Then Cells(i, "B") = Cells(i, "B") & a(j)
If Right(Cells(i, "A"), Len(a(j))) = a(j) Then Cells(i, "C") = Cells(i, "C") & a(j)
End If
Next j
Next i
Application.ScreenUpdating = True
MsgBox "İŞLEM BİTMİŞTİR....", vbInformation, "Necdet YEŞERTENER--->www.excel.web.tr"
End Sub