• Web sitemize destek olmak, Hazır Excel Dosyaları indirmek ve sitemizi reklamsız kullanmak için VIP Üyelik Satın alabilirsiniz.
    Hesabını VIP Üyeliğe Yükselt

Soru Farklı Sayfalardan tabloya veri alma?

mars2

Yeni Üye
Kullanıcı
Versiyon
  1. Excel 2010
Sürüm
  1. 64 bit
Dil
  1. Türkçe

Reputation:

İyi Günler;
Liste adlı kitapta 3 adet sayfa bulunmaktadır.
1. sayfa Liste,
2. sayfa rapor,
3. sayfa analiste,

rapor sayfasında tablomun C3 hücresine dosya nosu yazdığımda C4, c5, c6, c7, c8, c9, c10 . c13 ila c18 arasındaki hücreler, ve c21 ila c23 arasındaki hücrelere analiste sayfasından,
Yine C26, c27, c30, c31, c32 hücrelerine ise Liste sayfasından veri almak istiyorum. Örnek ektedir.

Konu hakkında yardımlarınzla,
 

Ekli dosyalar

  • LİSTE.xlsm
    119.7 KB · Görüntüleme: 7

leguminosea

Forum Yönetimi
Yönetici
Site Yöneticisi
Versiyon
  1. Excel 2019
Sürüm
  1. 64 bit
Dil
  1. Türkçe

Reputation:

Bilgi olan satırlara formüller girildi.
Diğer satırları bunlara göre düzenleyebilirsiniz.
 

Ekli dosyalar

  • LİSTE.xlsm
    120.2 KB · Görüntüleme: 3

mars2

Yeni Üye
Kullanıcı
Versiyon
  1. Excel 2010
Sürüm
  1. 64 bit
Dil
  1. Türkçe

Reputation:

Sayın leguminosea;​

İlginiz için teşekkürler,
Formülle yapmışsınız. Ancak, zaman içinde yanlışlıkla formülleri silinmesi mümkün olduğundan bunu kodla yapmak istiyorum. Bu konuda yardımlarınızı beklemekteyim.
 

leguminosea

Forum Yönetimi
Yönetici
Site Yöneticisi
Versiyon
  1. Excel 2019
Sürüm
  1. 64 bit
Dil
  1. Türkçe

Reputation:

Deneyiniz.
Kod:
Sub ara()
Set r = Sheets("rapor")
Set l = Sheets("liste")
Set a = Sheets("analiste")
d = r.Cells(3, 3)
ssa = a.Cells(Rows.Count, 2).End(xlUp).Row
ssl = l.Cells(Rows.Count, 2).End(xlUp).Row

For i = 4 To 23
    If r.Cells(i, 1) <> Empty Then
        s = WorksheetFunction.Match(r.Cells(i, 1), a.Rows(3), 0) - 1
        r.Cells(i, 3) = WorksheetFunction.VLookup(d, a.Range("B4:AG" & ssa), s, 0)
    End If
Next i
s = Empty
For i = 26 To 27
    If r.Cells(i, 1) <> Empty Then
        s = WorksheetFunction.Match(r.Cells(i, 1), l.Rows(3), 0) - 1
        r.Cells(i, 3) = WorksheetFunction.VLookup(d, l.Range("B4:V" & ssl), s, 0)
    End If
Next i
    If r.Cells(30, 1) <> Empty Then
        r.Cells(30, 3) = WorksheetFunction.VLookup(d, l.Range("B4:V" & ssl), 19, 0)
    End If
    If r.Cells(31, 1) <> Empty Then
        r.Cells(31, 3) = WorksheetFunction.VLookup(d, l.Range("B4:V" & ssl), 20, 0)
    End If
    If r.Cells(36, 1) <> Empty Then
        r.Cells(36, 3) = WorksheetFunction.VLookup(d, l.Range("B4:V" & ssl), 21, 0)
    End If

End Sub
 

mars2

Yeni Üye
Kullanıcı
Versiyon
  1. Excel 2010
Sürüm
  1. 64 bit
Dil
  1. Türkçe

Reputation:

Sayın leguminosea;​


İlginize teşekkürler. Bilgisayarın başında bulunmadığım cevabınıza geç bakabildim.

Ancak, yazdığınız kodu örnek uygulamada denediğim zaman hata vermektedir.


1617253911614.png
 

AhmetRasim

Forum Yönetimi
Yönetici
Site Yöneticisi
Versiyon
  1. Excel 2019
Sürüm
  1. 32 bit
Dil
  1. Türkçe

Reputation:

Merhabalar Sn. @mars2
Alternatif olarak aşağıdaki kodları kullanabilirsiniz.

-- Rapor isimli sayfanın kod bölümüne ekleyiniz.
Rich (BB code):
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [C3]) Is Nothing Then Exit Sub

Dim analiste As Worksheet, Liste As Worksheet
Dim dNo As Long, aSon As Long, lSon As Long
Set analiste = Sheets("analiste"): Set Liste = Sheets("Liste")
aSon = analiste.Range("A" & Rows.Count).End(xlUp).Row
lSon = Liste.Range("A" & Rows.Count).End(xlUp).Row

'----- Ana Liste Sayfası İçin -----
On Error GoTo analiste_dno
dNo = analiste.Range("B5:B" & aSon).Find(Range("C3")).Row
    If dNo = 0 Then
analiste_dno:
        MsgBox Range("C3") & " numaralı dosya AnaListe Sayfasında yok!", vbInformation, "Bilgi"
        Exit Sub
    End If
Range("C4") = analiste.Cells(dNo, "F") 'Zemin No
Range("C5") = analiste.Cells(dNo, "D") 'İlçe
Range("C6") = analiste.Cells(dNo, "E") 'Mahalle&Köy
Range("C7") = analiste.Cells(dNo, "G") 'Ada
Range("C8") = analiste.Cells(dNo, "H") 'Parsel
Range("C9") = analiste.Cells(dNo, "I") 'Yüzölçümü
Range("C10") = analiste.Cells(dNo, "L") 'Hisse

'Diğer hücreler içinde bu şekilde tanımlama yapabilirsiniz.
'-------------------------------------------------------------


'----- Liste Sayfası İçin -----
On Error GoTo liste_dno
dNo = Liste.Range("B4:B" & lSon).Find(Range("C3")).Row
    If dNo = 0 Then
liste_dno:
        MsgBox Range("C3") & " numaralı dosya Liste Sayfasında yok!", vbInformation, "Bilgi"
        Exit Sub
    End If
Range("C26") = Liste.Cells(dNo, "R") 'Tarih
Range("C27") = Liste.Cells(dNo, "S") 'sayı

'Diğer hücreler içinde bu şekilde tanımlama yapabilirsiniz.
'-------------------------------------------------------------

Set analiste = Nothing: Set Liste = Nothing
dNo = 0: aSon = 0: lSon = 0
End Sub
Not: Kod güncellenmiştir.
 

mars2

Yeni Üye
Kullanıcı
Versiyon
  1. Excel 2010
Sürüm
  1. 64 bit
Dil
  1. Türkçe

Reputation:

Sayın AhmetRasim;​


Kod için teşekkürler, kod örnekte çalışmakta ancak, dosya nosu yanlış veya farklı yazınca;
dNo = analiste.Range("B5:B" & aSon).Find(Range("C3")).Row satırı hata vermektedir.
Ancak, analistede ve liste böyle dosya nosu bulunmayınca, MsgBox "ARADIĞINIZ BULUNAMADI.", vbInformation, "BİLGİ" mesajı vermesi halinde hata giderilmiş olabilir mi ve nasıl çözebiliriz.
 

mars2

Yeni Üye
Kullanıcı
Versiyon
  1. Excel 2010
Sürüm
  1. 64 bit
Dil
  1. Türkçe

Reputation:

İyi Günler;

Rapor sayfasındaki C3 hücresine dosya nosu yazdığımda, C4 hücresi (Birleştirilmiş olup C4:F4) ile diğer hücrelerinin (C5,C6, C7 vd...) içini silmesi veya temizlemesini aşağıdaki kodla yapmak istediğimde,

Sheets("rapor").Range("C4:F4").ClearContents

aSon = analiste.Range("A" & Rows.Count).End(xlUp).Row satırında hata vermekte olup excel kapanmaktadır.

hata nerede ve nasıl hücrelerin içini temizlemek mümkündür.
 

leguminosea

Forum Yönetimi
Yönetici
Site Yöneticisi
Versiyon
  1. Excel 2019
Sürüm
  1. 64 bit
Dil
  1. Türkçe

Reputation:

ikisinden biri olması lazım
Kod:
aSon = sheets("analiste").Range("A" & Rows.Count).End(xlUp).Row
veya
Kod:
Set a = Sheets("analiste")
aSon = a.Range("A" & Rows.Count).End(xlUp).Row
 

AhmetRasim

Forum Yönetimi
Yönetici
Site Yöneticisi
Versiyon
  1. Excel 2019
Sürüm
  1. 32 bit
Dil
  1. Türkçe

Reputation:

Merhabalar Sn. @mars2
İlk mesajdaki paylaştığınız dosyada hücreler birleştirilmiş ve paylaştığım kodlar ile C3 hücresi boş olduğu zaman diğer hücreler de hata vermeden temizleniyor. Hata aldığınız dosyayı, kodları ile paylaşır mısınız?
 
Üst