#YOK bul değiştir ara

[oydemir]

İyi günler

Sizlerden 2 konuda yardım rica edeceğim, Formda yazdınız kodla (bul1) değerleri buluyorum. Bulduğu oeğerlede hiç bir sorunum olmuyor. Bulamadı değerlere (#YOK ) diyor. Bulduğum değerlerden (kod2 ) kodu ile parça alıyorum.

Parça alırken (#YOK ) değerini görünce hata veriyor bul değiştirten (#YOK ) değerlerini yok edince kodlar çalışıyor.

Formda bulduğum (değiştir kodu) normalde çalışıyor fakat (#YOK ) değerini bulup değiştirmiyor.

Yardım islediğim bul kodundu nasıl bir değişiklik yapılırsa bulunmadığı değerlere (#YOK) yerine hiç bir şey yazmaması(“”) (eğer hata formülü gibi)

İkincisi bul değiştir kodunda #YOK değerini bulup yok etmesi ni nasıl sağlıya bilirim. Teşekkürler





Sub bu1 ()

Sheets(" liste").Range("S:S").Copy

Sheets("NUTUS").Range("E:E").PasteSpecial

Application.CutCopyMode = False 'DOĞUM TARİHİ





Dim s1 As Worksheet

Dim s2 As Worksheet

Dim Bul As Range

Dim Bul1 As Range





Set s1 = Sheets(" liste")

Set s2 = Sheets("BİRİM")

Set s3 = Sheets("NUTUS")

Set S4 = Sheets("ADRES")





Sheets(" liste").Select



son = Cells(Rows.Count, "A").End(3).Row ' ARANACAK SON SATIR

'S1.Range("AE2:AE" & S1.Rows.Count).ClearContents

dz = s3.Range("F1:F" & son).Value

dz1 = s3.Range("g1:g" & son).Value

dz2 = s3.Range("h1:h" & son).Value

dz3 = s3.Range("ı1:ı" & son).Value

dz4 = s3.Range("j1:j" & son).Value

dz5 = s3.Range("k1:k" & son).Value





For i = 2 To son

If s1.Cells(i, "O") <> "" Then 'ARANACAK SUTUN

Set Bul = s2.Range("d:d").Find(s1.Cells(i, "o"), , , xlWhole) 'ARANACAK KOLON

Set Bul1 = S4.Range("b:b").Find(s1.Cells(i, "ag"), , , xlWhole) 'ARANACAK KOLON



If Not Bul Is Nothing Then

dz(i, 1) = Application.VLookup(s1.Cells(i, "o"), s2.Range("d:y"), 22, 0)

dz1(i, 1) = Application.VLookup(s1.Cells(i, "o"), s2.Range("d:r"), 15, 0)

dz2(i, 1) = Application.VLookup(s1.Cells(i, "ag"), S4.Range("b:e"), 4, 0)

dz3(i, 1) = Application.VLookup(s1.Cells(i, "ag"), S4.Range("b:f"), 5, 0)

dz4(i, 1) = Application.VLookup(s1.Cells(i, "ag"), S4.Range("b:ı"), 8, 0)

dz5(i, 1) = Application.VLookup(s1.Cells(i, "ag"), S4.Range("b:d"), 3, 0)



End If

End If

Next i



s3.Range("f1:f" & son).Value = dz

s3.Range("g1:g" & son).Value = dz1

s3.Range("h1:h" & son).Value = dz2

s3.Range("ı1:ı" & son).Value = dz3

s3.Range("j1:j" & son).Value = dz4

s3.Range("k1:k" & son).Value = dz5



Application.Calculation = xlCalculationAutomatic

Application.ScreenUpdating = True

End sub



Sub2 ()

If sat < 1 Then Exit Sub

Application.ScreenUpdating = False



For i = 2 To sat

For M = 1 To 1

Cells(i, M + 10).Value = Mid(Cells(i, "k").Value, M, 5)

Cells(i, M + 9).Value = Mid(Cells(i, "j").Value, M, 7)

Cells(i, M + 8).Value = Mid(Cells(i, "I").Value, M, 9)

Next

Next

End sub



Sub Degisir()



Range("A3:A5000").Replace [d5], [e6]

End Sub

Columns("A:z").Select
Selection.Replace What:="#YOK", Replacement:="aa", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False

 

[Muzaffer Ali]

Cells(i, M + 10).Value = Mid(Cells(i, "k").Value, M, 5)
Cells(i, M + 9).Value = Mid(Cells(i, "j").Value, M, 7)
Cells(i, M + 8).Value = Mid(Cells(i, "I").Value, M, 9)

Satırını silin yerine aşağıdaki kodu kopyalayın

    Cells(i, M + 10).Value = IIf(IsError(Mid(Cells(i, "k").Value, M, 5)), "", Mid(Cells(i, "k").Value, M, 5))
    Cells(i, M + 9).Value = IIf(IsError(Mid(Cells(i, "j").Value, M, 7)), "", Mid(Cells(i, "j").Value, M, 7))
    Cells(i, M + 8).Value = IIf(IsError(Mid(Cells(i, "I").Value, M, 9)), "", Mid(Cells(i, "I").Value, M, 9))

 

[oydemir]

sayın Muzaffer Ali bey
Beceremedim örnek dosya ekledim yardım edebilirseniz teşekkür ederim.
H,I,J,K, sütunlarından verileri kırpıp H,I,J,K, sütunlarına yazdırmak

 

[Muzaffer Ali]

H1, I1, J1 ve K1'e normal excel formülü girip onları benimle paylaşın.

 

[oydemir]

ilginiz için çok teşekkür ederim

 

[Muzaffer Ali]

Merhaba.
Aşağıdaki kodu çalıştırdığınızda M:P aralığına topluca formül sonucu uygulanır.

Sub test()
    With Range("M2:P" & Cells(Rows.Count, "A").End(xlUp).Row)
        .FormulaLocal = "=EĞER(A2>1;PARÇAAL(H2;1;20);"""")"
        .Value = .Value
    End With
End Sub

 

[oydemir]

teşekkürler elinize bilginize sağlık