sayfalararası veri aktarımı

[purpledarkness]

aynı çalışma kitabındaki iki çalışma sayfasında veri aktarımı yapacağız,veri aktarımı yaparken mükerer kayıtları teke indireceğiz ve o mükerrer kayıtları teke indirirken toplayarak yazacağız,
Ek'te ki dosyada açıklamayı yaptım, yardımlarınızı bekliyorum.

 

[gezgin-49]

aynı çalışma kitabındaki iki çalışma sayfasında veri aktarımı yapacağız,veri aktarımı yaparken mükerer kayıtları teke indireceğiz ve o mükerrer kayıtları teke indirirken toplayarak yazacağız,
Ek'te ki dosyada açıklamayı yaptım, yardımlarınızı bekliyorum.

Sayın purpledarkness mükerrer kayıtları iptal edebilmek için "ANALİZ" sayfasının
kod bölümüne
Sub mükerer()
For sil = [a65536].End(3).Row To 1 Step -1
If WorksheetFunction.CountIf(Range("A1:A" & sil), Range("A" & sil)) > 1 Then Rows(sil).Delete
Next
End Sub

yazın, daha sonra "ANALİZ" sayfası
"B2" hücresine
=DÜŞEYARA($A2;'HAM VERİ'!$A$2:$E$16;2;0)
"C2" hücresine ise
=DÜŞEYARA($A2;'HAM VERİ'!$A$2:$E$16;3;0) formüllerini yerleştirin
işlem buraya kadar tamam ancak fatura adetleri ve fatura bedellerini toplamayı başaramadım, bu konuda uzman arkadaşların yardımları gerekiyor.

 

[N.Ziya Hiçdurmaz]

Yanıt

Sub AKTAR()
Dim SH, SA As Worksheet
Dim SUT, SUT1, S As Integer
Set SH = Sheets("HAM VERİ")
Set SA = Sheets("ANALİZ")
SA.[A2:E1000].Clear
S = 2
For SUT = 2 To SH.Cells(65536, "B").End(3).Row
If WorksheetFunction.CountIf(SH.Range("B2:B" & SUT), SH.Cells(SUT, "B")) = 1 Then
Range(SH.Cells(SUT, "A"), SH.Cells(SUT, "D")).Copy
SA.Cells(S, "A").PasteSpecial Paste:=xlValues
S = S + 1
End If
Next
Application.CutCopyMode = False
For SUT = 2 To SH.Cells(65536, "B").End(3).Row
For SUT1 = 2 To SA.Cells(65536, "B").End(3).Row
If SH.Cells(SUT, "B") = SA.Cells(SUT1, "B") Then
SA.Cells(SUT1, "E") = SA.Cells(SUT1, "E") + SH.Cells(SUT, "E")
End If
Next
Next
MsgBox "İşlem tamam", vbInformation
Set SH = Nothing
Set SA = Nothing
End Sub

 

[gezgin-49]

Sayın üstadım müthiş olmuş,ellerinize sağlık, daha sizlerden öğrenecek çok şeyimiz var, ben sadece mükerrer kayıtları süzdürebilmiştim, ama önce verilerin Ham Veri Sayfasından Analiz sayfasına aktarılması gerekiyordu bu kısmı atlamışım, Saygılarımı sunuyorum.

 

[purpledarkness]

sayın Hiçdurmaz yardımlarınızdan ötürü çok teşekkür ederim, aynı işlemi formül ile yapmak istesek yapabilirmiyiz.
aslında makra işime yarıyor ama örnek dosyamda birkaç gereksiz sütun daha vardı onları dahil etmedim, makroyu asıl dosyama tatbik ederken hata yaparım diye korkuyorum, formülle yapılabilirse, formülün mantığını anlayıp prototipini sunduğum dosyadan asıl dosyama daha sağlıklı uygularım diye düşündüm.

eğer formül ile yapılmazsa bu makro üzerinde çalışırım ama yine de yardımınız için çok teşekkür ederim. iyi çalışmalar.

 

[purpledarkness]

Sub AKTAR()
Dim SH, SA As Worksheet
Dim SUT, SUT1, S As Integer
Set SH = Sheets("HAM VERİ")
Set SA = Sheets("ANALİZ")
SA.[A2:E1000].Clear
S = 2
For SUT = 2 To SH.Cells(65536, "B").End(3).Row
If WorksheetFunction.CountIf(SH.Range("B2:B" & SUT), SH.Cells(SUT, "B")) = 1 Then
Range(SH.Cells(SUT, "A"), SH.Cells(SUT, "D")).Copy
SA.Cells(S, "A").PasteSpecial Paste:=xlValues
S = S + 1
End If
Next
Application.CutCopyMode = False
For SUT = 2 To SH.Cells(65536, "B").End(3).Row
For SUT1 = 2 To SA.Cells(65536, "B").End(3).Row
If SH.Cells(SUT, "B") = SA.Cells(SUT1, "B") Then
SA.Cells(SUT1, "E") = SA.Cells(SUT1, "E") + SH.Cells(SUT, "E")
End If
Next
Next
MsgBox "İşlem tamam", vbInformation
Set SH = Nothing
Set SA = Nothing
End Sub

Bir de aktarırken; belge adedini toplamamış yine sadece tc kimlik nosu olanları aktarmamış.

 

[N.Ziya Hiçdurmaz]

Yanıt

Bu şekil deneyiniz

Sub AKTAR()
Dim SH, SA As Worksheet
Dim SUT, SUT1, S As Integer
Set SH = Sheets("HAM VERİ")
Set SA = Sheets("ANALİZ")
SA.[A2:E1000].Clear
S = 2
For SUT = 2 To SH.Cells(65536, "B").End(3).Row
If WorksheetFunction.CountIf(SH.Range("B2:B" & SUT), SH.Cells(SUT, "B")) = 1 Then
Range(SH.Cells(SUT, "A"), SH.Cells(SUT, "D")).Copy
SA.Cells(S, "A").PasteSpecial Paste:=xlValues
S = S + 1
End If
Next
Application.CutCopyMode = False
S = 2
For SUT1 = 2 To SA.Cells(65536, "B").End(3).Row
SA.Cells(S, "E") = WorksheetFunction.SumIf(SH.Range("B2:B65536"), SA.Cells(SUT1, "B"), SH.Range("E2:E65536"))
SA.Cells(S, "D") = WorksheetFunction.SumIf(SH.Range("B2:B65536"), SA.Cells(SUT1, "B"), SH.Range("D2:D65536"))
S = S + 1
Next
MsgBox "İşlem tamam", vbInformation
Set SH = Nothing
Set SA = Nothing
End Sub

 

[purpledarkness]

Bu şekil deneyiniz

Sub AKTAR()
Dim SH, SA As Worksheet
Dim SUT, SUT1, S As Integer
Set SH = Sheets("HAM VERİ")
Set SA = Sheets("ANALİZ")
SA.[A2:E1000].Clear
S = 2
For SUT = 2 To SH.Cells(65536, "B").End(3).Row
If WorksheetFunction.CountIf(SH.Range("B2:B" & SUT), SH.Cells(SUT, "B")) = 1 Then
Range(SH.Cells(SUT, "A"), SH.Cells(SUT, "D")).Copy
SA.Cells(S, "A").PasteSpecial Paste:=xlValues
S = S + 1
End If
Next
Application.CutCopyMode = False
S = 2
For SUT1 = 2 To SA.Cells(65536, "B").End(3).Row
SA.Cells(S, "E") = WorksheetFunction.SumIf(SH.Range("B2:B65536"), SA.Cells(SUT1, "B"), SH.Range("E2:E65536"))
SA.Cells(S, "D") = WorksheetFunction.SumIf(SH.Range("B2:B65536"), SA.Cells(SUT1, "B"), SH.Range("D2:D65536"))
S = S + 1
Next
MsgBox "İşlem tamam", vbInformation
Set SH = Nothing
Set SA = Nothing
End Sub

çok teşekkürler.

 

[Orion1]

Formülle yapılmış şekli.
Dosyanız ekte.

 

[purpledarkness]

Formülle yapılmış şekli.
Dosyanız ekte.

Sayın Evren Gizlen;

formülle yapmanız çok güzel ama bazı sıkıntılar var, Analiz sayfasına aktarırken fatura adedini ve fatura bedellerini toplayarak getirmesini istiyorum yani; Ham Veri sayfasında tek bir vergi numarasına ait 256 adet satır olsun, benim stediğim bu tek vergi numaralı firmayı Analiz sayfasında tek satır göstersin ama diğer satırları toplayarak yani 256 adet satırdaki fatura adedi ve fatura tutarlarını toplayarak göstersin.

 

[Orion1]

Sayın Evren Gizlen;

formülle yapmanız çok güzel ama bazı sıkıntılar var, Analiz sayfasına aktarırken fatura adedini ve fatura bedellerini toplayarak getirmesini istiyorum yani; Ham Veri sayfasında tek bir vergi numarasına ait 256 adet satır olsun, benim stediğim bu tek vergi numaralı firmayı Analiz sayfasında tek satır göstersin ama diğer satırları toplayarak yani 256 adet satırdaki fatura adedi ve fatura tutarlarını toplayarak göstersin.

Anlaşıldı tamam.
Şimdi hallederiz.

 

[Orion1]

Dosyanız ekte.

 

[purpledarkness]

Dosyanız ekte.

çok teşekkür ederim istediğim gibi olmuş,
farklı bir konuyla ilgili bir şey sorabilirmiyim, vergi numarlarını farklı yerlkerden konsolide ettim, ve örneğpin bazıları 1111111111 yazmış öteki aynı vergi numarasını 111 111 1111 yazmış, bunları tek bir biçime dönüştürmek için vergi numarasının olduğu sütunu seçip Düzen>Değiştir>Aranan kısma Boşluk karekteri; Yerine yazılan değeride boş bırakırsam sorun çözülür galiba değil mi?

çok fazla satırlı bir tablo olduğu için korkarak işlem tatbik ediyorum o yüzden sizin gibi uzmanlara sormadan işlem yapmaktan imtina ediyorum.

sayın Evren Gizlen yardımlarınızdan dolayı tekrar teşekkür ederim.
İyi pazarlar.

 

[Orion1]

çok teşekkür ederim istediğim gibi olmuş,
farklı bir konuyla ilgili bir şey sorabilirmiyim, vergi numarlarını farklı yerlkerden konsolide ettim, ve örneğpin bazıları 1111111111 yazmış öteki aynı vergi numarasını 111 111 1111 yazmış, bunları tek bir biçime dönüştürmek için vergi numarasının olduğu sütunu seçip Düzen>Değiştir>Aranan kısma Boşluk karekteri; Yerine yazılan değeride boş bırakırsam sorun çözülür galiba değil mi?

çok fazla satırlı bir tablo olduğu için korkarak işlem tatbik ediyorum o yüzden sizin gibi uzmanlara sormadan işlem yapmaktan imtina ediyorum.

sayın Evren Gizlen yardımlarınızdan dolayı tekrar teşekkür ederim.
İyi pazarlar.

Önce bir yedek dosya hazırlayın ve onda deneyin.Ne olmaz ne olmaz hatalı bir karakter girebilirsiniz.Olması lazım.
İyi çalışmalar.