If li bir kod da bir hata

[haso_excel]

Merhaba arkadaşlar,

Sub HIYERARSI()
On Error Resume Next
For i = 2 To WorksheetFunction.CountA(Range("c:c"))
If Left(Cells(i, "c"), WorksheetFunction.Find(" ", Cells(i, "c")) - 1) = "AS" Then
Cells(i, 1).Value = 40001
ElseIf Left(Cells(i, "c"), WorksheetFunction.Find(" ", Cells(i, "c")) - 1) = "DİLEK" Then
Cells(i, 1).Value = 40002
ElseIf Left(Cells(i, "c"), WorksheetFunction.Find(" ", Cells(i, "c")) - 1) = "HEDEF" Then
Cells(i, 1).Value = 40006
ElseIf Left(Cells(i, "c"), WorksheetFunction.Find(" ", Cells(i, "c")) - 1) = "NEVZAT" Then
Cells(i, 1).Value = 40007
ElseIf Left(Cells(i, "c"), WorksheetFunction.Find(" ", Cells(i, "c")) - 1) = "SELÇUK" Then
Cells(i, 1).Value = 40008
ElseIf Left(Cells(i, "c"), WorksheetFunction.Find(" ", Cells(i, "c")) - 1) = "SS.İSTANBUL" Then
Cells(i, 1).Value = 40009
ElseIf Left(Cells(i, "c"), WorksheetFunction.Find(" ", Cells(i, "c")) - 1) = "YUSUFPAŞA" Then
Cells(i, 1).Value = 40010
ElseIf Left(Cells(i, "c"), WorksheetFunction.Find(" ", Cells(i, "c")) - 1) = "EDAK" Then
Cells(i, 1).Value = 40003
End If
If Cells(i, 1).Value = "" Then Cells(i, 1).Value = "DİĞER"
Next i
MsgBox "İŞLEM TAMAM"
End Sub

Kod ile eklediğim dosyadaki verileri kontrol ettiriyorum. Sonuçlarınıda A koluna yazdırıyorum. Fakat anlayamadığım bir şey oluyor. Kısaca şöyle ; C kolunda ki ilk boşlukdan sonraki kelimeyi kontrol ettirip, A koluna bir değer atıyorum. Bulamazsa "Diğer yazdırmaya çalıyorum ama ilk İf deki değeri getiriyor. Kodu çalıştırınca anlayacaksınız.

 

[Ömer]

Merhaba,

Hatayı ilk satırda bulduğu için "On Error Resume Nex" hatayı atlatarak ilk satırdaki şartı yazdırıp yoluna devam ediyor.

Aşağıdaki yazım daha sade ve doğru bir yazım şekli olacaktır.

Sub HIYERARSI()
 
    On Error Resume Next
 
    Range("A2:A" & Rows.Count).ClearContents
 
    For i = 2 To Cells(Rows.Count, "C").End(xlUp).Row
        If Split(Cells(i, "C"), " ")(0) = "AS" Then
            Cells(i, "A").Value = 40001
        ElseIf Split(Cells(i, "C"), " ")(0) = "DİLEK" Then
            Cells(i, "A").Value = 40002
        ElseIf Split(Cells(i, "C"), " ")(0) = "HEDEF" Then
            Cells(i, "A").Value = 40006
        ElseIf Split(Cells(i, "C"), " ")(0) = "NEVZAT" Then
            Cells(i, "A").Value = 40007
        ElseIf Split(Cells(i, "C"), " ")(0) = "SELÇUK" Then
            Cells(i, "A").Value = 40008
        ElseIf Split(Cells(i, "C"), " ")(0) = "SS.İSTANBUL" Then
            Cells(i, "A").Value = 40009
        ElseIf Split(Cells(i, "C"), " ")(0) = "YUSUFPAŞA" Then
            Cells(i, "A").Value = 40010
        ElseIf Split(Cells(i, "C"), " ")(0) = "EDAK" Then
            Cells(i, "A").Value = 40003
        ElseIf Err.num > 0 Then Cells(i, "A").Value = "DİĞER"
        End If
    Next i
 
    MsgBox "İŞLEM TAMAM"
 
End Sub

.

 

[haso_excel]

Teşekkürler işlem tamam elinize sağlık