• DİKKAT

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

tablodaki verileri değerlere göre diğer tabloya aktarmak

C

cagdasexcel

Katılım
4 Şubat 2022
Mesajlar
6
Excel Vers. ve Dili
2016
Merhaba,

Aşağıda örneğini verdiğim excel sayfasında TABLO-1' deki istenen_deger_1 ve istenen_deger_2 değerlerini TABLO-2' deki veriler aracılığıyla getirmek istiyorum. Mesela TABLO-1' de name sütununda 1 tane 454 değeri var. TABLO-2' de ise istenen_deger_1 ve 2' de 2 tane farklı 454 değeri karşılığı değerler var. Şu an ki tablo ve yapmak istediğim tabloyu da aşağıya ekliyorum. Eklediğim örnek TABLO-1' in orijinal satır sayısı 1346, TABLO-2' nin ise 2546' dır.
Yardımlarınız için teşekkür ederim.


TABLO-1











name

score_1

score_2

istenen_deger_1

istenen_deger_2

score_3

103a2

-21​

0.998​





up

454

-21​

0.995​





up

4778

-21​

0.983​





up

302b

-21​

0.951​





up

302d

-21​

0.946​





up

6893

-21​

0.995​





up

6865

-21​

0.992​





up

103a2

-21​

0.989​





up

4722

-21​

0.987​





up

4686

-21​

0.987​





up

1285

-21​

0.986​





up

6808

-21​

0.984​





up

1285

-21​

0.984​





up


TABLO-2





name

istenen_deger_1

istenen_deger_2

103a2

ELMA

A

454

ARMUT

A

454

ELMA

B

4778

ÜZÜM

A

4778

ELMA

B

302b

KAVUN

A

302d

KARPUZ

A

302d

ELMA

B

6893

ARMUT

A

6865

ELMA

A

302d

ÜZÜM

C

103a2

ERİK

A

103a2

ELMA

B

4722

KARPUZ

A

4686

ELMA

A

4686

ERİK

B

1285

KAVUN

A

6808

KARPUZ

A

1285

KAYISI

B


İSTENEN TABLO-1











name

score_1

score_2

istenen_deger_1

istenen_deger_2

score_3

454

-21​

0.995​

ARMUT

A

up

454

-21​

0.995​

ELMA

B

up

103a2

-21​

0.998​

ELMA

A

up

103a2

-21​

0.998​

ERİK

A

up

103a2

-21​

0.998​

ELMA

B

up
 
İstenen tabloda ilk 2 satırda name sütunu 454, Tablo1 de bir tane 454 var. Bu satırdan 2 tane olması lazım değil mi?
103a2 Tablo1 de 2 tane var, Tablo2 de 3 tane. İstenende ise 3 satır var. Bunun sebebi nedir?
İstenen tablo dediğiniz tablo sadece Tablo2 ye göremi oluşacak
Eğer sadece Tablo2 ye göreyse score2 kısımları Tablo1 de birbirinden farklıyken neden istenen tabloda hepsi aynı?
 
Hayır TABLO-1' de 1 tane 454 var. TABLO-2' deki 2. 454 ve karşısındaki değeri yazacağımız formül ya da makro ile ekleyebileceğiz. Tablolardaki analizler farklı olduğundan satır sayıları farklı olabiliyor. Amacım da zaten bunları bir bütün haline getirebilmek. Veri çok olduğundan yeni satır ekle vb butonları kullanarak çok zaman kaybedeceğim.
Evet Tablo-2' deki istenen_deger_1 ve 2 Tablo-1' e aktarılması gerekiyor. Aynı değerden birden fazla satırda var ise o satırları da eklemem gerekecek.
 
Son soruma cevap vermemişsiniz. Biraz da değiştirerek sorayım.
İstenen tablodaki skorların nereden geliyor? Hangi kıstasla geliyor?

Not: Sorunuzu lütfen eksiksiz sorunuz. Siz bir soru sordunuz ben 4 soru sormak zorunda kaldım
 
ÖmerFaruk' Alıntı:
Son soruma cevap vermemişsiniz. Biraz da değiştirerek sorayım.
İstenen tablodaki skorların nereden geliyor? Hangi kıstasla geliyor?

Not: Sorunuzu lütfen eksiksiz sorunuz. Siz bir soru sordunuz ben 4 soru sormak zorunda kaldım
Genişletmek için tıkla ...
Skorlar önemli değil, arada başka sütunlar olduğunu belirtmek için eklemiştim, herhangi bir kıstasla gelmiyor, dikkate alınmayabilir.
 
Sorunuza örnek bir dosya eklemediniz.
Ben de kendim bir dosya oluşturdum. Bu dosyanın yapısına uygun olarak kodlar aşağıda dosya da linkte eklidir.
Umarım kendi dosyanıza uyarlarsınız.
Bu Linkten dosyanıza erişebilirsiniz

Hazırladığım dosyada İstenenTablo sayfasına girince kodlar aktif olmaktadır.
C++: 
Private Sub Worksheet_Activate()
    Dim Veri, Liste1(), Liste2(), Liste3(), xDict As Object
    Range("A2:A" & Rows.Count).ClearContents
    Range("D2:D" & Rows.Count).ClearContents
    Range("E2:E" & Rows.Count).ClearContents
    Son = Worksheets("Tablo2").Range("A" & Rows.Count).End(3).Row
    If Son < 3 Then Exit Sub
    Veri = Worksheets("Tablo2").Range("A2:C" & Son).Value
    Set xDict = CreateObject("Scripting.Dictionary")
    
    For i = 1 To UBound(Veri)
        If Not xDict.Exists(Veri(i, 1)) Then
            xDict.Add Veri(i, 1), i
        Else
            xDict(Veri(i, 1)) = xDict(Veri(i, 1)) & "+" & i
        End If
    Next i
    
    ReDim Liste1(1 To UBound(Veri), 1 To 1)
    ReDim Liste2(1 To UBound(Veri), 1 To 1)
    ReDim Liste3(1 To UBound(Veri), 1 To 1)
    For Each Key In xDict.Keys
        If InStr(1, xDict(Key), "+") > 0 Then
            Degerler = Split(xDict(Key), "+")
            For k = 0 To UBound(Degerler)
                Say = Say + 1
                Liste1(Say, 1) = Veri(Degerler(k) * 1, 1)
                Liste2(Say, 1) = Veri(Degerler(k) * 1, 2)
                Liste3(Say, 1) = Veri(Degerler(k) * 1, 3)
            Next k
        End If
    Next Key
    Range("A2").Resize(Say, 1) = Liste1
    Range("D2").Resize(Say, 1) = Liste2
    Range("E2").Resize(Say, 1) = Liste3
End Sub
 
ÖmerFaruk' Alıntı:
Sorunuza örnek bir dosya eklemediniz.
Ben de kendim bir dosya oluşturdum. Bu dosyanın yapısına uygun olarak kodlar aşağıda dosya da linkte eklidir.
Umarım kendi dosyanıza uyarlarsınız.
Bu Linkten dosyanıza erişebilirsiniz

Hazırladığım dosyada İstenenTablo sayfasına girince kodlar aktif olmaktadır.
C++: 
Private Sub Worksheet_Activate()
    Dim Veri, Liste1(), Liste2(), Liste3(), xDict As Object
    Range("A2:A" & Rows.Count).ClearContents
    Range("D2:D" & Rows.Count).ClearContents
    Range("E2:E" & Rows.Count).ClearContents
    Son = Worksheets("Tablo2").Range("A" & Rows.Count).End(3).Row
    If Son < 3 Then Exit Sub
    Veri = Worksheets("Tablo2").Range("A2:C" & Son).Value
    Set xDict = CreateObject("Scripting.Dictionary")
   
    For i = 1 To UBound(Veri)
        If Not xDict.Exists(Veri(i, 1)) Then
            xDict.Add Veri(i, 1), i
        Else
            xDict(Veri(i, 1)) = xDict(Veri(i, 1)) & "+" & i
        End If
    Next i
   
    ReDim Liste1(1 To UBound(Veri), 1 To 1)
    ReDim Liste2(1 To UBound(Veri), 1 To 1)
    ReDim Liste3(1 To UBound(Veri), 1 To 1)
    For Each Key In xDict.Keys
        If InStr(1, xDict(Key), "+") > 0 Then
            Degerler = Split(xDict(Key), "+")
            For k = 0 To UBound(Degerler)
                Say = Say + 1
                Liste1(Say, 1) = Veri(Degerler(k) * 1, 1)
                Liste2(Say, 1) = Veri(Degerler(k) * 1, 2)
                Liste3(Say, 1) = Veri(Degerler(k) * 1, 3)
            Next k
        End If
    Next Key
    Range("A2").Resize(Say, 1) = Liste1
    Range("D2").Resize(Say, 1) = Liste2
    Range("E2").Resize(Say, 1) = Liste3
End Sub
Genişletmek için tıkla ...
Merhaba yardımlarınız için teşekkür ederim, ancak dosyayı indirme linki açılmıyor.
 
Link çalışıyor..

Linke tıkladığınızda açılan pencerenin biraz altına doğru inerseniz YEŞİL renkli indirme butonunu görebilrisiniz.
 
ÖmerFaruk' Alıntı:
Sorunuza örnek bir dosya eklemediniz.
Ben de kendim bir dosya oluşturdum. Bu dosyanın yapısına uygun olarak kodlar aşağıda dosya da linkte eklidir.
Umarım kendi dosyanıza uyarlarsınız.
Bu Linkten dosyanıza erişebilirsiniz

Hazırladığım dosyada İstenenTablo sayfasına girince kodlar aktif olmaktadır.
C++: 
Private Sub Worksheet_Activate()
    Dim Veri, Liste1(), Liste2(), Liste3(), xDict As Object
    Range("A2:A" & Rows.Count).ClearContents
    Range("D2:D" & Rows.Count).ClearContents
    Range("E2:E" & Rows.Count).ClearContents
    Son = Worksheets("Tablo2").Range("A" & Rows.Count).End(3).Row
    If Son < 3 Then Exit Sub
    Veri = Worksheets("Tablo2").Range("A2:C" & Son).Value
    Set xDict = CreateObject("Scripting.Dictionary")
   
    For i = 1 To UBound(Veri)
        If Not xDict.Exists(Veri(i, 1)) Then
            xDict.Add Veri(i, 1), i
        Else
            xDict(Veri(i, 1)) = xDict(Veri(i, 1)) & "+" & i
        End If
    Next i
   
    ReDim Liste1(1 To UBound(Veri), 1 To 1)
    ReDim Liste2(1 To UBound(Veri), 1 To 1)
    ReDim Liste3(1 To UBound(Veri), 1 To 1)
    For Each Key In xDict.Keys
        If InStr(1, xDict(Key), "+") > 0 Then
            Degerler = Split(xDict(Key), "+")
            For k = 0 To UBound(Degerler)
                Say = Say + 1
                Liste1(Say, 1) = Veri(Degerler(k) * 1, 1)
                Liste2(Say, 1) = Veri(Degerler(k) * 1, 2)
                Liste3(Say, 1) = Veri(Degerler(k) * 1, 3)
            Next k
        End If
    Next Key
    Range("A2").Resize(Say, 1) = Liste1
    Range("D2").Resize(Say, 1) = Liste2
    Range("E2").Resize(Say, 1) = Liste3
End Sub
Genişletmek için tıkla ...
Kendi dosyama uyarlamaya çalışacağım. Yardımınız için teşekkür ederim.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst