otomatik veri aktarımı

[hakanaslan78]

Merhaba arkadaşlar,

Yardımlarınız için şimdiden teşekkür ederim. Sorum şu şekilde olacak. Excel dosyamda iki adet sayfam bulunmakta. Birinci sayfamın a sütün dan başlayarak, 30000 adet veri bulunmakta ve bu veriler sql den otomatik geldiği için sürekli değişmekte. Bu veriler den bir den fazla tekrarı olan ve olmayanlar var. Benim istediğim, verilerin bulunduğu sayfadaki a sütunundaki değerleri, tekrar edenleri bir kere, tekrarı olmayanlar ile birlikte, ikinci sayfam deki a sütununa otomatik aktarmak. Sql den gelen veriler yenilendiğin de, ikinci sayfadaki değerlerin de otomatik yenilenmesini istiyorum.

Saygılarımla,

 

[Erdem Akdemir]

Örnek dosya ekleyebilir misiniz.

 

[Asri]

Merhaba arkadaşlar,

Yardımlarınız için şimdiden teşekkür ederim. Sorum şu şekilde olacak. Excel dosyamda iki adet sayfam bulunmakta. Birinci sayfamın a sütün dan başlayarak, 30000 adet veri bulunmakta ve bu veriler sql den otomatik geldiği için sürekli değişmekte. Bu veriler den bir den fazla tekrarı olan ve olmayanlar var. Benim istediğim, verilerin bulunduğu sayfadaki a sütunundaki değerleri, tekrar edenleri bir kere, tekrarı olmayanlar ile birlikte, ikinci sayfam deki a sütununa otomatik aktarmak. Sql den gelen veriler yenilendiğin de, ikinci sayfadaki değerlerin de otomatik yenilenmesini istiyorum.

Saygılarımla,

SQL den gelen veriler bir sorgu ile geliyordur.
İmkan var ise bu sorguda tekrarlı verileri elemek doğru olur.

 

[hakanaslan78]

Örnek dosya ekleyebilir misiniz.

Merhaba Erdem bey,

Ayrıntılı olarak dosyayı ekliyorum. Dosyayı incelediğiniz de ve müsait olursanız telefon da bir iki dakika konuşa bilirmiyiz.

Saygılarımla,

 

[Erdem Akdemir]

Ekteki tabloyu dener misiniz.

 

[Erdem Akdemir]

Merhaba,

Dosyanız ektedir.
ADO ve klasik vba birlikte kullanılmıştır.

Sub denemem()

Sayfa5.Select
son = Cells(Rows.Count, 1).End(3).Row
Range("A2:G" & son).ClearContents


Set con = VBA.CreateObject("adodb.Connection")

con.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
ThisWorkbook.FullName & ";extended properties=""Excel 12.0;hdr=yes"""

sorgu = "transform sum([TL Net Tutar Kdvli]) select [Ch kodu],[CH Ünvanı] from[SATIŞLAR$] " & _
        "group by [Ch kodu],[CH Ünvanı] pivot tarih & ' SATIŞLAR' "

Set rs = con.Execute(sorgu)

Range("A2").CopyFromRecordset rs

son = Cells(Rows.Count, 1).End(3).Row
sonv = Sheets("ch hesaplar").Cells(Rows.Count, 1).End(3).Row
alan = Sheets("ch hesaplar").Range("B2:H" & son)


Range("C2:E" & son).NumberFormat = "#,##0.00"
Range("G2:G" & son).NumberFormat = "#,##0.00"

x = 1
For Each baslik In rs.Fields

Cells(1, x) = baslik.Name
x = x + 1

Next baslik

For i = 2 To son

Cells(i, "f") = Application.VLookup(Cells(i, "a"), alan, 2, 0)
Cells(i, "g") = Application.VLookup(Cells(i, "a"), alan, 6, 0)
Cells(i, "h") = Application.VLookup(Cells(i, "a"), alan, 7, 0)

Next i
Cells.EntireColumn.AutoFit

End Sub

 

[hakanaslan78]

Merhaba,

Dosyanız ektedir.
ADO ve klasik vba birlikte kullanılmıştır.

Sub denemem()

Sayfa5.Select
son = Cells(Rows.Count, 1).End(3).Row
Range("A2:G" & son).ClearContents


Set con = VBA.CreateObject("adodb.Connection")

con.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
ThisWorkbook.FullName & ";extended properties=""Excel 12.0;hdr=yes"""

sorgu = "transform sum([TL Net Tutar Kdvli]) select [Ch kodu],[CH Ünvanı] from[SATIŞLAR$] " & _
        "group by [Ch kodu],[CH Ünvanı] pivot tarih & ' SATIŞLAR' "

Set rs = con.Execute(sorgu)

Range("A2").CopyFromRecordset rs

son = Cells(Rows.Count, 1).End(3).Row
sonv = Sheets("ch hesaplar").Cells(Rows.Count, 1).End(3).Row
alan = Sheets("ch hesaplar").Range("B2:H" & son)


Range("C2:E" & son).NumberFormat = "#,##0.00"
Range("G2:G" & son).NumberFormat = "#,##0.00"

x = 1
For Each baslik In rs.Fields

Cells(1, x) = baslik.Name
x = x + 1

Next baslik

For i = 2 To son

Cells(i, "f") = Application.VLookup(Cells(i, "a"), alan, 2, 0)
Cells(i, "g") = Application.VLookup(Cells(i, "a"), alan, 6, 0)
Cells(i, "h") = Application.VLookup(Cells(i, "a"), alan, 7, 0)

Next i
Cells.EntireColumn.AutoFit

End Sub

Merhaba Erdem bey,

Emeklerinize sağlık, hazırlamış olduğunuz kodlar çok işime yaradı.

Saygılarımla,