DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Sub duzenle()
Dim i As Long
Sheets("Sayfa1").Select
Set f = Range("A5:IV5").Find("sektorad", , xlValues, xlWhole)
If f Is Nothing Then
MsgBox "[sektorad ] metini bulunamadı.Makro çalıştırılmadı.", vbCritical
Exit Sub
End If
adr1 = Range(Cells(6, f.Column), Cells(Cells(65536, f.Column).End(xlUp).Row, f.Column)).Address
Range(adr1).Replace What:="HİZMET", Replacement:="49", LookAt:=xlPart
Range(adr1).Replace What:="İNŞAAT", Replacement:="50", LookAt:=xlPart
Range(adr1).Replace What:="İMALAT", Replacement:="37", LookAt:=xlPart
Range(adr1).Replace What:="ENERJİ", Replacement:="54", LookAt:=xlPart
Range(adr1).Replace What:="TEKSTİL", Replacement:="4", LookAt:=xlPart
Range("L6:L" & Cells(65536, "L").End(xlUp).Row).Replace What:="YTL", Replacement:="0", LookAt:=xlPart
Range("L6:L" & Cells(65536, "L").End(xlUp).Row).Replace What:="USD", Replacement:="1", LookAt:=xlPart
Range("L6:L" & Cells(65536, "L").End(xlUp).Row).Replace What:="EUR", Replacement:="50", LookAt:=xlPart
Application.ScreenUpdating = False
For i = Cells(65536, "I").End(xlUp).Row To 6 Step -1
If IsError(Cells(i, "I").Value) And Cells(i, "O").Value = "" _
And Cells(i, "Q").Value = "" And Cells(i, "R").Value = "" Then
Rows(i).Delete
End If
Next i
Application.ScreenUpdating = True
MsgBox "İŞLEM TAMAMLANDI", vbOKOnly + vbInformation
End Sub
Rica ederim.Orion ilgin için teşekkürler kardeş,çok saol
O durum pek açık değildi.Yalnız sevgili orion tamam yazdıgın makro değiştirmeleri yapıyo ama şu istediğim #yok ve belli sütunların boş olması halinde o satırın silinmesi işlemini gerçekleştirmiyor sanırım,ben mi yanlış bi,şeyler yapıyorum acaba?
Rica ederim.çok teşşekür ederim orion ellerine ve emeğine sağlık...