vba method of object "range" failed hatası

[ufny]

Merhabalar,

aşağıdaki gibi bir kodlamam vardı. Otomatik bir isim düzeltmesi. Ancak bu hatayı vermeye başladı Neden olabilir acaba ?


Sub konaklama()

Dim rng As Range

Range(Range("AE2"), Range("AE2").End(xlDown)).ClearContents


For Each rng In Range(Range("K2"), Range("K2").End(xlDown))

Select Case True
Case rng.Value Like "*1AD+1CH*"
result = "1AD+1CHD"
Case rng.Value Like "*1AD+2CH*"
result = "1AD+2CHD"
Case rng.Value Like "*1AD+3CH*"
result = "1AD+3CHD"
Case rng.Value Like "2AD"
result = "'2AD"
Case rng.Value Like "*2AD+1CH*"
result = "'2AD+1CHD"
Case rng.Value Like "*2AD+2CH*"
result = "'2AD+2CHD"
Case rng.Value Like "*2AD+3CH*"
result = "'2AD+3CHD"
Case rng.Value Like "--3 PAX--"
result = "'3AD"
Case rng.Value Like "3AD"
result = "'3AD"
Case rng.Value Like "*3AD+1CH*"
result = "'3AD+1CHD"
Case rng.Value Like "*3AD+2CH*"
result = "'3AD+2CHD"
Case rng.Value Like "*3AD+3CH*"
result = "'3AD+3CHD"
Case rng.Value Like "--4 PAX--"
result = "'4AD"
Case rng.Value Like "4AD"
result = "'4AD"
Case rng.Value Like "*4AD+1CH*"
result = "'4AD+1CHD"
Case rng.Value Like "*4AD+2CH*"
result = "'4AD+2CHD"
Case rng.Value Like "*4AD+3CH*"
result = "'4AD+3CHD"
Case rng.Value Like "--5 PAX--"
result = "'5AD"
Case rng.Value Like "5AD"
result = "'5AD"
Case rng.Value Like "*5AD+1CH*"
result = "'5AD+1CHD"
Case rng.Value Like "*5AD+2CH*"
result = "'5AD+2CHD"
Case rng.Value Like "--6 PAX--"
result = "'6AD"
Case rng.Value Like "*6AD+1CH*"
result = "'6AD+1CHD"
Case rng.Value Like "*6AD+2CH*"
result = "'6AD+2CHD"
Case rng.Value Like "*7AD+1CH*"
result = "'7AD+1CHD"
Case rng.Value Like "*7AD+2CH*"
result = "'7AD+2CHD"
Case rng.Value Like "*DBL*"
result = "'2AD"
Case rng.Value Like "--SGL--"
result = "'1AD"
Case rng.Value Like "1AD"
result = "'1AD"
Case rng.Value Like "-1 PAX-"
result = "'1AD"
Case rng.Value Like "10AD"
result = "'10AD"
Case rng.Value Like "2ADL"
result = "'2AD"
Case rng.Value Like "3ADL"
result = "'3AD"
Case Else
result = "YOK"

End Select
rng.Offset(0, 20).Value = result
Next


End Sub

 

[Muzaffer Ali]

Merhaba.

Dosyanızı paylaşırsanız daha hızlı ve doğru yanıt alırsınız.
Dosyanızı dosya.co gibi bir sitede paylaşabilirsiniz.

 

[ufny]

Merhabalar, malesef IP engellemesinden kaynaklı yükleyemiyorum. Ama görünüşü bu şekilde ;

Screenshot-1 hosted at ImgBB

Image Screenshot-1 hosted in ImgBB

ibb.co

 

[Muzaffer Ali]

Google Drive ye yükleyip paylaşıma açabilirsiniz.

 

[ufny]

deneme.xlsm

drive.google.com

 

[Muzaffer Ali]

Herhangi bir hata vermiyor.

 

[ufny]

Çok yavaş çalışıyor, kapatınca bu hatayı verdi ana dosyada. Hızlandırmak için bir öneriniz var mı yoksa beklemek mi gerekiyor sadece.

İlginiz için teşekkürler.

 

[Muzaffer Ali]

Bunu deneyin.

Sub TEST()
    Dim Aranan As Variant
    Dim YeniDeger As Variant
    Dim Bak As Integer
    Dim Zaman As Date
    Zaman = Now
    Range("AE2:AE" & Cells(Rows.Count, "AE").End(xlUp).Row).ClearContents
    Range("K2:K" & Cells(Rows.Count, "K").End(xlUp).Row).Copy Range("AE2")
    
    Aranan = Array("*1AD+1CH*", "*1AD+2CH*", "*1AD+3CH*", "2AD", "*2AD+1CH*", "*2AD+2CH*", "*2AD+3CH*", "--3 PAX--", "3AD", "*3AD+1CH*", "*3AD+2CH*", "*3AD+3CH*", "--4 PAX--", "4AD", "*4AD+1CH*", "*4AD+2CH*", "*4AD+3CH*", "--5 PAX--", "5AD", "*5AD+1CH*", "*5AD+2CH*", "--6 PAX--", "*6AD+1CH*", "*6AD+2CH*", "*7AD+1CH*", "*7AD+2CH*", "*DBL*", "--SGL--", "1AD", "-1 PAX-", "10AD", "2ADL", "3ADL")
    YeniDeger = Array("1AD+1CHD", "1AD+2CHD", "1AD+3CHD", "'2AD", "'2AD+1CHD", "'2AD+2CHD", "'2AD+3CHD", "'3AD", "'3AD", "'3AD+1CHD", "'3AD+2CHD", "'3AD+3CHD", "'4AD", "'4AD", "'4AD+1CHD", "'4AD+2CHD", "'4AD+3CHD", "'5AD", "'5AD", "'5AD+1CHD", "'5AD+2CHD", "'6AD", "'6AD+1CHD", "'6AD+2CHD", "'7AD+1CHD", "'7AD+2CHD", "'2AD", "'1AD", "'1AD", "'1AD", "'10AD", "'2AD", "'3AD")
    
    For Bak = 0 To UBound(Aranan)
        Range("AE:AE").Replace What:=Aranan(Bak), Replacement:=YeniDeger(Bak), LookAt:=xlWhole, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
    Next
    MsgBox "Tamamlandı." & vbLf & vbLf & Left(--(Now - Zaman), 1) & " saniye sürdü."
End Sub

 

[ufny]

Nazik cevabınız için teşekkürler. Kullanacağım. Kolay gelsin.