Ekteki dosyada örnek bir excel var. Parça adları sutununda yazılan değerler belli bir kategoriye göre mk1,mk2 veya mk3 de işlenecektir. Benim yapmak istediğim,
eğer hücrede alt plaka yazıyorsa mk1 ve mk3 e 1 yaz. Kavela yazıyorsa mk11 e 1 yaz şeklinde. İç içe eğer formülü ile yaparım diyorum. Ama iç içe eğer formülünün bir sınırı var. Sizce başka ne tür bir yol izlemem gerekir.
Aşağıda bir kod var. Bu kod, belli kelimleri silme bende bunu tersine çevirerek üzerinde bir takım değişikliler yapmak istiyorum ama bilemiyorum.
Sub kategori()
Dim sutun As String, son As Long, deg, i As Long, durum As Boolean, j As Integer
sutun = InputBox("İşlem yapmak istediğiniz sütun bilgisini giriniz.", , "A")
If sutun = "" Then Exit Sub
son = Cells(Rows.Count, sutun).End(xlUp).Row
deg = Array("*ARKA*DUVAR*")
Application.ScreenUpdating = False
For i = son To 1 Step -1
durum = False
For j = 0 To UBound(deg)
If Cells(i, sutun) Like deg(j) Then durum = True
If durum = True Then Exit For
Next j
If durum = True Then Rows(i).Delete Shift:=xlUp
Next i
Application.ScreenUpdating = True
MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub
eğer hücrede alt plaka yazıyorsa mk1 ve mk3 e 1 yaz. Kavela yazıyorsa mk11 e 1 yaz şeklinde. İç içe eğer formülü ile yaparım diyorum. Ama iç içe eğer formülünün bir sınırı var. Sizce başka ne tür bir yol izlemem gerekir.
Aşağıda bir kod var. Bu kod, belli kelimleri silme bende bunu tersine çevirerek üzerinde bir takım değişikliler yapmak istiyorum ama bilemiyorum.
Sub kategori()
Dim sutun As String, son As Long, deg, i As Long, durum As Boolean, j As Integer
sutun = InputBox("İşlem yapmak istediğiniz sütun bilgisini giriniz.", , "A")
If sutun = "" Then Exit Sub
son = Cells(Rows.Count, sutun).End(xlUp).Row
deg = Array("*ARKA*DUVAR*")
Application.ScreenUpdating = False
For i = son To 1 Step -1
durum = False
For j = 0 To UBound(deg)
If Cells(i, sutun) Like deg(j) Then durum = True
If durum = True Then Exit For
Next j
If durum = True Then Rows(i).Delete Shift:=xlUp
Next i
Application.ScreenUpdating = True
MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub
Son düzenleme: