Veri tabanı gibi bir şey oluşturma?

[tkabaca]

Selam arkadaşlar;

eklediğim dosyada sayfa_1'deki bilgi girişinde yer alan satırdaki bilgileri sayfa_2'deki tablo'ya aktarmak istiyorum. bilgi girişi ve tablo aynı sayfada ise bunu sağlayan bir makro kullanıyorum ama makrolara çok hakim olamadığım için tablonun başka sayfada olduğu duruma uyarlayamadım.

Tabii tablonun en altına eklemesi yerine tablo'daki ilk boş satıra eklemesi daha iyi olur. Çünkü tablo'da bir satırı silersem yeni bilgilerin bu satıra gelmesini istiyorum. (bu da elimdeki makro'da uyarlayamadığım bir kısım)

Bunu bir makroyu bilgilerin yanına koyduğum düğmeye tıklayarak yapacağım. Yani makroyu düğmeye atayacağım.

Yardımcı olursanı çok sevinirim...

 

[Ayhan Ercan]

Merhaba
Ek dosyayı inceleyiniz...

Option Base 1
Sub Düğme1_Tıklat()
    son = Array(Sayfa2.[a65536].End(3).Row + 1, Sayfa2.[b65536].End(3).Row + 1, _
    Sayfa2.[c65536].End(3).Row + 1, Sayfa2.[d65536].End(3).Row + 1)
    For i = 1 To 4
    Sayfa2.Cells(son(i), i) = Cells(2, i)
    Next i
End Sub

 

[Ayhan Ercan]

...Tabii tablonun en altına eklemesi yerine tablo'daki ilk boş satıra eklemesi daha iyi olur. Çünkü tablo'da bir satırı silersem yeni bilgilerin bu satıra gelmesini istiyorum. (bu da elimdeki makro'da uyarlayamadığım bir kısım)
...

Burasını atlamışım herhalde...

Bu durumda da aşağıdaki kodları deneyiniz...

Option Base 1
Sub Düğme1_Tıklat()
Dim hcr As Range
For Each hcr In Sayfa2.Range("a2:a" & Sayfa2.[a65536].End(3).Row)
    If hcr = Empty Then
        For j = 1 To 4
            Sayfa2.Cells(hcr.Row, j) = Cells(2, j)
        Next
        Exit Sub
    End If
Next
    son = Array(Sayfa2.[a65536].End(3).Row + 1, Sayfa2.[b65536].End(3).Row + 1, _
    Sayfa2.[c65536].End(3).Row + 1, Sayfa2.[d65536].End(3).Row + 1)
    For i = 1 To 4
        Sayfa2.Cells(son(i), i) = Cells(2, i)
    Next i
End Sub

 

[tkabaca]

Ayhan bey;

İlginize çok teşekkür ederim. Yazdığınız kodlar kesinlikle işime yarayacak. Ancak hem daha iyi öğrenebilmem hem de yazdığınız kodları asıl çalışma sayfama uyarlayabilmem için mümkün olduğu kadar yazdığınız kodun bir açıklamasını ekleyebilir misiniz...

Benim tablom ve tablo'ya aktarılacak verilerim. örnekteki yerlerinde değil ve 1 saat filan uğraştım ve bir türlü kodların neresini değiştirirsem benim tablomda çalışacağını bulamadım...

 

[tkabaca]

Ayhan bey;
İlginize çok teşekkür ederim. Yazdığınız kodlar kesinlikle işime yarayacak. Ancak hem daha iyi öğrenebilmem hem de yazdığınız kodları asıl çalışma sayfama uyarlayabilmem için mümkün olduğu kadar yazdığınız kodun bir açıklamasını ekleyebilir misiniz...
Benim tablom ve tablo'ya aktarılacak verilerim. örnekteki yerlerinde değil ve 1 saat filan uğraştım ve bir türlü kodların neresini değiştirirsem benim tablomda çalışacağını bulamadım...

 

[tkabaca]

benim verilerim sayfa3'te A5, B5, C5, D5 hücrelerinde ve bu verileri aktarmak istediğim tablo sayfa4'te A10, B10, C10 ve E10 hücrelerinden başlıyor.

Not: Tabloda C10 ve D10 hücreleri ile E10 ve F10 hücreleri birleştirilmiş durumda ama bu birleştirilmiş hücrenin üzerine gelince hücre adresini gösteren kısımdaki adresleri yazdım. Sanırım benim sorunum buradan kaynaklanıyor.

Aslında bu şekilde bir dosya eklesem iyi olacak

 

[Ayhan Ercan]

...yazdığınız kodun bir açıklamasını ekleyebilir misiniz...

Elimden geldiğince, birşeyler yazmaya çalıştım. Umarım anlaşılır olmuştur.

Option Base 1 [COLOR=seagreen][B]' dizi değerlerin 1 ile başlamasını sağlama[/B][/COLOR]
Sub Düğme1_Tıklat()
Dim hcr As Range [COLOR=seagreen][B]' hcr adında değişken tanımlama[/B][/COLOR]
For Each hcr In Sayfa2.Range("a2:a" & Sayfa2.[a65536].End(3).Row) [COLOR=seagreen][B]' Sayfa2.nin "a2" hücresinden son dolu "a" hücresi arasına hcr adında döngü kurma[/B][/COLOR]
    If hcr = Empty Then [B][COLOR=seagreen]' eğer "hcr" boş ise[/COLOR][/B]
        For j = 1 To 4 [COLOR=seagreen][B]'1 den 4 e kadar j adında döngü kurma[/B][/COLOR]
            Sayfa2.Cells(hcr.Row, j) = Cells(2, j) [COLOR=seagreen][B]' sayfa2 nin boş bulduğu hücre satırı (hcr.row) ile "j-döngüsündeki" sütununa 2.satır[/B][/COLOR]
[B][COLOR=seagreen]           ' "j-döngüsündeki" sütundaki değeri yazma[/COLOR][/B]
        Next [B][COLOR=seagreen]' j döngüsünü arttırma[/COLOR][/B]
        Exit Sub [B][COLOR=seagreen]' makrodan çıkma[/COLOR][/B]
    End If [B][COLOR=seagreen]' eğer sonu[/COLOR][/B]
Next [COLOR=seagreen][B]' hcr döngüsünü artırma[/B][/COLOR]
    son = Array(Sayfa2.[a65536].End(3).Row + 1, Sayfa2.[b65536].End(3).Row + 1, _
    Sayfa2.[c65536].End(3).Row + 1, Sayfa2.[d65536].End(3).Row + 1) [B][COLOR=seagreen]' son adında dizi oluşturma[/COLOR][/B]
    For i = 1 To 4 [COLOR=seagreen][B]' i döngüsü kurma[/B][/COLOR]
        Sayfa2.Cells(son(i), i) = Cells(2, i) [COLOR=seagreen][B]'sayfa2 nin son dizisinin "i-döngüsü" halindeki satır ile "j-döngüsündeki" sütununa 2.satır[/B][/COLOR]
[B][COLOR=seagreen]           ' "i-döngüsündeki" sütundaki değeri yazma[/COLOR][/B]
    Next i [B][COLOR=seagreen]' i döngüsünü artırma[/COLOR][/B]
End Sub [B][COLOR=seagreen]' makroyu sonlandırma[/COLOR][/B]

 

[tkabaca]

herhalde şu an bilgisayar başındasınız benim son cevabımdan sonra cevap yazmışsınız...
teşekkürler ama benim asıl istediğim hücre adreslerinin nasıl okunması gerektiği...
Sizin cevabınızdan önceki yazımda bir tablo ekledim. sanırım sorun birleştirilmiş hücrelerde...Göz atabilir misiniz...

 

[Ayhan Ercan]

Tekrar Merhaba

Aşağıdaki Kodu düğmeye atayın ve deneyiniz..

Option Base 1
Sub Düğme1_Tıklat()
Dim hcr As Range
For Each hcr In Sayfa2.Range("a10:a" & Sayfa2.[a65536].End(3).Row)
    If hcr = Empty Then
        For j = 1 To 3
            Sayfa2.Cells(hcr.Row, j) = Sayfa1.Cells(5, j)
            
        Next
            Sayfa2.Cells(hcr.Row, 5) = Sayfa1.Cells(5, 4)
        Exit Sub
    End If
Next
    son = Array(Sayfa2.[a65536].End(3).Row + 1, Sayfa2.[b65536].End(3).Row + 1, _
    Sayfa2.[c65536].End(3).Row + 1, Sayfa2.[e65536].End(3).Row + 1)
    For i = 1 To 3
        Sayfa2.Cells(son(i), i) = Sayfa1.Cells(5, i)
    Next i
        Sayfa2.Cells(son(4), 5) = Sayfa1.Cells(5, 4)
End Sub

 

[tkabaca]

Teşekkürler Ayhan bey;

Sanırım bu işi kapıyorum. Tahmin ettiğim gibi sorun birleştirilmiş hücre ile ilgili imiş dimi?... Bu sorunu A'dan C hücresine kadar döngü kurup E hücresini döngü dışında doldurarak çözmüşsünüz. Zaten başka nasıl olacaktı ki!....

Tekrar ilginize teşekkür ederim...