veri çekme

[sinnernekolens]

Merhaba Değerli arkadaşlar. İyi günler
Kısaca VERI sayfasına kaydettiğim bilgileri Makro ile veri çek butonunu kullanarak Hesap sayfasındaki D sütununa verileri aktarmak istiyorum.

Vessel name yazan kısma ismini yazdığım zaman karşılık gelen bilileri çekebilir. veya bir kod oluşturup ona karşılık gelen bilgileride çekebilir.
Yardımlarınızı rica ederim.

 

[YUSUF44]

Formülle yapabilirsiniz. Aşağıdaki formülü D3 hücresine yapıştırıp aşağıya doğru kopyalayın. Formüldeki 27'yi veri uzunluğuna göre değiştirebilirsiniz:

=İNDİS(VERI!$B$2:$E$27;KAÇINCI($D$2;VERI!$B$2:$B$27;0);KAÇINCI($C3;VERI!$B$1:$E$1;0))

Yok ben illa düğmeye basınca olmasını istiyorum diyorsanız aşağıdaki kodları bir modüle kopyalayıp deneyiniz:

Sub vericek()
son = Sheets("VERI").Cells(Rows.Count, "B").End(3).Row
[D3] = WorksheetFunction.VLookup([D2], Sheets("VERI").Range("B2:E" & son), 4, 0)
[D4] = WorksheetFunction.VLookup([D2], Sheets("VERI").Range("B2:E" & son), 2, 0)
[D5] = WorksheetFunction.VLookup([D2], Sheets("VERI").Range("B2:E" & son), 3, 0)
End Sub

Ya da A1'e veri girdiğimde düğmeye basmadan otomatik güncellesin derseniz aşağıdaki kodları ilgili sayfanın kod bölümüne yapıştırıp deneyiniz:

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [D2]) Is Nothing Then Exit Sub
son = Sheets("VERI").Cells(Rows.Count, "B").End(3).Row
[D3] = WorksheetFunction.VLookup(Target, Sheets("VERI").Range("B2:E" & son), 4, 0)
[D4] = WorksheetFunction.VLookup(Target, Sheets("VERI").Range("B2:E" & son), 2, 0)
[D5] = WorksheetFunction.VLookup(Target, Sheets("VERI").Range("B2:E" & son), 3, 0)
End Sub

 

[sinnernekolens]

Cevabınız için teşekkür ederim.
Vermiş olduğunuz kodu kullandım ve D2 Hücresine veri doğrulama yaptım listeden gemi ismini seçiyorum karşılık gelen bilgileri çekiyor bu şekilde güzel oldu.

1- D hücresine manuel olarak da bilgi girişi yapabileceğim şekilde nasıl yapabilirim D2 hücresine manuel giriş yaparken aşağıdaki uyarıyı alıyorum bu uyarıyı almadan nasıl yapılabilir.

2 -Ayrıca Mümkün ise Manuel olarak girdiğim bilgileri Kaydet butonuna basarak VERI sayfasındaki sıralamaya ekleye bilir mi.

 

[YUSUF44]

Mevcut kodları aşağıdakiyle değiştirip, sayfadaki düğmenize Kaydet makrosunu atayınız:

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [D2]) Is Nothing Then Exit Sub
son = Sheets("VERI").Cells(Rows.Count, "B").End(3).Row
If WorksheetFunction.CountIf(Sheets("VERI").Range("B2:D" & son), Target) = 0 Then
[D1] = "Gemi veritabanında yok"
MsgBox "Yazdığınız gemi veritabanında bulunmamaktadır. " & Chr(10) & _
    "Eğer yeni bir gemiyse bilgileri girdikten sonra Kaydet düğmesine basınız.", vbOKOnly
GoTo 10
End If
[D1] = "Gemi veritabanında bulundu, bilgileri getirildi"
[D3] = WorksheetFunction.VLookup(Target, Sheets("VERI").Range("B2:E" & son), 4, 0)
[D4] = WorksheetFunction.VLookup(Target, Sheets("VERI").Range("B2:E" & son), 2, 0)
[D5] = WorksheetFunction.VLookup(Target, Sheets("VERI").Range("B2:E" & son), 3, 0)
10:
End Sub

Sub kaydet()
yeni = Sheets("VERI").Cells(Rows.Count, "B").End(3).Row + 1
If WorksheetFunction.CountIf(Sheets("VERI").Range("B2:B" & yeni), [D2]) > 0 Then
MsgBox "Yazdığınız gemi veritabanında bulunmaktadır. " & Chr(10) & _
    "Lütfen girdiğiniz bilgileri kontrol ediniz.", vbOKOnly
GoTo 10
End If

Sheets("VERI").Cells(yeni, "A") = yeni - 1
Sheets("VERI").Cells(yeni, "B") = [D2]
Sheets("VERI").Cells(yeni, "C") = [D4]
Sheets("VERI").Cells(yeni, "D") = [D5]
Sheets("VERI").Cells(yeni, "E") = [D3]
10:
End Sub

 

[sinnernekolens]

Yusuf bey allah razı olsun sağol. Çok teşekkür ediyorum.

 

[sinnernekolens]

Yusuf bey bu konu ile ilgili son bir sorum olacak; korumalı sayfada aşağıdaki kodu çalıştırmanın bir yöntemi var mıdır? Değiştirilmesini istemediğim yerler var o yüzden korumam gerekiyor.

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [D2]) Is Nothing Then Exit Sub
son = Sheets("VERI").Cells(Rows.Count, "B").End(3).Row
If WorksheetFunction.CountIf(Sheets("VERI").Range("B2" & son), Target) = 0 Then
[D1] = "Gemi veritabanında yok"
MsgBox "Yazdığınız gemi veritabanında bulunmamaktadır. " & Chr(10) & _
"Eğer yeni bir gemiyse bilgileri girdikten sonra Kaydet düğmesine basınız.", vbOKOnly
GoTo 10
End If
[D1] = "Gemi veritabanında bulundu, bilgileri getirildi"
[D3] = WorksheetFunction.VLookup(Target, Sheets("VERI").Range("B2:E" & son), 4, 0)
[D4] = WorksheetFunction.VLookup(Target, Sheets("VERI").Range("B2:E" & son), 2, 0)
[D5] = WorksheetFunction.VLookup(Target, Sheets("VERI").Range("B2:E" & son), 3, 0)
10:
End Sub

 

[YUSUF44]

Makroya sayfa kilidini kaldıran ve işlem yaptıktan sonra tekrar kilitleyen kod eklenebilir. Bunun için dosyanızı son isteğinize göre güncelleyip tam olarak ne istediğinizi belirtmeniz iyi olur.

 

[sinnernekolens]

Merhaba tekradan, dosyayı ekledim sayfa koruma şifresi 0 gemi ismi seçerken sayfa korumalı olduğu için hata veriyor. kilit açılınca sorunsuz çalışıyor.
Dediğiniz gibi sayfa kilidini kaldıran ve işlem yaptıktan sonra tekrar kilitleyen kod ekleyebilirsek çok iyi olur.

 

[sinnernekolens]

Merhaba iyi günler,bir önceki 8nolu mesajımda yanlış göndermişim eki; Yusuf beyin vermiş odluğu VBA kodu kullanarak G5 hücresinden gemi ismi seçildiği zaman o gemiye karşılık gelen bilgileri VERI sayfasından otomatik çekiyor veya manuel olarak girdiğim bilgileri VERI sayfasına butona tıkladığımda kaydediyor herşey çok güzel fakat sayfa yapısı bozulmasın diye sayfa koruması yaptığım zaman. aşağıdaki hatayı alıyorum ve kod çalışmıyor bunun bir çaresi var mıdır? Sayfanın korumalı kalması gerekiyor.