• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Vba`da ikinci error komutu

Katılım
21 Ekim 2008
Mesajlar
2,323
Excel Vers. ve Dili
Office 2013 - Eng
Kod:
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo dip
Set referans = [h4]

If Intersect(Target, referans) Is Nothing Then Exit Sub
[c11] = "MESSRS:" & " " & "`" & Application.WorksheetFunction.VLookup(referans, Sheets("Freights").Range("a:J"), 10, 0) & "`"
[c11].Font.Bold = True
[c11].Characters(Start:=1, Length:=8).Font.FontStyle = Bold

[c4] = Application.WorksheetFunction.VLookup(referans, Sheets("Freights").Range("a:b"), 2, 0)

[g5] = "DUE DATE:" & " " & Format(Application.WorksheetFunction.VLookup(referans, Sheets("Freights").Range("a:K"), 11, 0), "dd.mm.yyyy")
[g5].Font.Bold = True
[g5].Characters(Start:=1, Length:=9).Font.FontStyle = Bold

[c16] = "M/T" & " " & Application.WorksheetFunction.VLookup(referans, Sheets("Freights").Range("a:C"), 3, 0)
[c16].Font.Bold = True
[c16].Characters(Start:=1, Length:=4).Font.FontStyle = Bold

[E16] = Application.WorksheetFunction.VLookup(referans, Sheets("Freights").Range("a:F"), 6, 0) & " - " & Application.WorksheetFunction.VLookup(referans, Sheets("Freights").Range("a:G"), 7, 0)

[c18] = Application.WorksheetFunction.VLookup(referans, Sheets("Freights").Range("a:H"), 8, 0)
[c18].Font.Bold = True


[d18] = "MTS       " & Application.WorksheetFunction.VLookup(referans, Sheets("Freights").Range("a:I"), 9, 0)
[d18].Font.Bold = True
[d18].Characters(Start:=1, Length:=4).Font.FontStyle = Bold

[d20] = Application.WorksheetFunction.VLookup(referans, Sheets("Freights").Range("a:E"), 5, 0)
[d20].Font.Bold = True

[c24] = Application.WorksheetFunction.VLookup(referans, Sheets("Freights").Range("a:D"), 4, 0)

[c26] = Application.WorksheetFunction.VLookup(referans, Sheets("Freights").Range("a:H"), 8, 0)

[e28] = Application.WorksheetFunction.VLookup(referans, Sheets("Freights").Range("a:L"), 12, 0)


If Range("c24") = "DEMURRAGE" Then
Range("C26") = "DEMURRAGE"
Range("C24:D24").ClearContents
Range("D26:F26").ClearContents
Else
[D26] = "MTS X USD"
[E26] = Application.WorksheetFunction.VLookup([E16], Range("L:M"), 2, 0)
[F26] = "PMT"
End If

Exit Sub
dip:
MsgBox "Hatali Giris, Yaptiniz!", vbInformation, "Ferit Bey Oooop!"
End Sub

Arkadaslar bu sekilde bir kodum var, if li bolgenin icindeki

Kod:
[E26] = Application.WorksheetFunction.VLookup([E16], Range("L:M"), 2, 0)

bu bolumun hata verme olasiligi var ve eger burda hata verirse boyle bir sefer yok demek istiyorum, fikri olan varmi acaba?
 
Merhaba,

Kod:
If WorksheetFunction.CountIf(Range("L:L"), [E16]) <> 0 Then
[E26] = Application.WorksheetFunction.VLookup([E16], Range("L:M"), 2, 0)
Else
[E26] = "Sefer Yok"
End If

Denermisiniz..

.
 
Cok basarili sayin Omer MsgBox kullanarak ayrica yapamazmiyim acaba, ama buda isimi gorur conditional formatla kirmizi filan yaparim ama ayrica bir MsgBox iyi olurdu..

elinize saglik; tesekkurler..
 
Cok basarili sayin Omer MsgBox kullanarak ayrica yapamazmiyim acaba, ama buda isimi gorur conditional formatla kirmizi filan yaparim ama ayrica bir MsgBox iyi olurdu..

elinize saglik; tesekkurler..

Kod:
If WorksheetFunction.CountIf(Range("L:L"), [E16]) <> 0 Then
[E26] = Application.WorksheetFunction.VLookup([E16], Range("L:M"), 2, 0)
Else
MsgBox [E16] & " Seferi Yok"
End If

Bu şekilde mi?

.
 
evet cok basitmis, tesekkurler tekrar tum sorun cozulmustur..
 
Sub vlookup_() 'DÜŞEY ARA
On Error GoTo hata
For sut = 1 To 3
Range("d" & sut) = WorksheetFunction.VLookup(Range("c" & sut), Sheets("Sheet2").Range("a:b"), 2, 0)
Next
Exit Sub
hata:
MsgBox "c sütununda verisiz hücreyi doldurmalısınız."
End Sub
Kodu siteden alıp kendime göre düzenlemeye çalştım. fakat sheet1 deki C sutunu dolu olasına rağmen neden hale nesaj veriyor
 
Geri
Üst