Sayfalar Arası Veri Aktarımı

R

rhombeus

Katılım
23 Aralık 2009
Mesajlar
114
Excel Vers. ve Dili
Excel 2003
Değerli Hocalar Merhabalar,

Ekte bir dosyamda GENEL HAFTALIK çalışma sayfasında uzunca bir veri listesi var. Bu listedeki müşterilerin verilerinin rapor sayfasındaki formata aktarmak istiyorum.

Örneğin: Müşteri Adı: ad1 olan müşterinin. Rapor sayfasında Satış, CH, Firma Çeki, Müşteri Çeki sutünlarındaki ilgili yerlerine getirmem gerekmekte. Rapor sayfasında ki 27, 28 ... şeklinde giden sutün başlıkları haftaları temsil etmekte.

Yardımcı olabilirseniz çok sevinirim. Saygılarımı sunarım.

İyi günler
 

Ekli dosyalar

R

rhombeus

Katılım
23 Aralık 2009
Mesajlar
114
Excel Vers. ve Dili
Excel 2003
Hocalarım fikir verebilecek veya yardım edebilecek kimse yok mu ?
 
halit3

halit3

Uzman
Uzman
Katılım
18 Ocak 2008
Mesajlar
12,853
Excel Vers. ve Dili
2003 excell türkçe
ve
2007 excell türkçe
ekli dosyayı bir kontrol ediniz.


Kod: 
Sub aktar()
Sheets("RAPOR").Rows("3:6").ClearContents
Sheets("RAPOR").Cells(3, 1).Value = "SATIŞ"
Sheets("RAPOR").Cells(4, 1).Value = "CH"
Sheets("RAPOR").Cells(5, 1).Value = "FİRMA ÇEKİ"
Sheets("RAPOR").Cells(6, 1).Value = "MÜŞTERİ ÇEKİ"
aranan1 = Sheets("RAPOR").Cells(1, "A").Value
For r = 3 To 27
If Sheets("RAPOR").Cells(1, "A").Value <> "" Then
If WorksheetFunction.CountIf(Worksheets("GENEL HAFTALIK").Range("C2:C" & r), aranan1) = 1 Then
For i = r To 27
sat = 2
aranan2 = Sheets("GENEL HAFTALIK").Cells(i, 3).Value
If aranan2 = aranan1 Then
For n = 5 To Worksheets("GENEL HAFTALIK").Cells(2, 255).End(xlToLeft).Column
Sheets("RAPOR").Cells(3, sat).Value = CDbl(Sheets("RAPOR").Cells(3, sat).Value) + CDbl(Sheets("GENEL HAFTALIK").Cells(i, n).Value)
Sheets("RAPOR").Cells(4, sat).Value = CDbl(Sheets("RAPOR").Cells(4, sat).Value) + CDbl(Sheets("GENEL HAFTALIK").Cells(i, n + 1).Value)
Sheets("RAPOR").Cells(5, sat).Value = CDbl(Sheets("RAPOR").Cells(5, sat).Value) + CDbl(Sheets("GENEL HAFTALIK").Cells(i, n + 2).Value)
Sheets("RAPOR").Cells(6, sat).Value = CDbl(Sheets("RAPOR").Cells(6, sat).Value) + CDbl(Sheets("GENEL HAFTALIK").Cells(i, n + 3).Value)
sat = sat + 1
n = n + 3
Next n
End If
Next i
End If
End If
Next r
MsgBox "işlem tamam"
End Sub
 

Ekli dosyalar

R

rhombeus

Katılım
23 Aralık 2009
Mesajlar
114
Excel Vers. ve Dili
Excel 2003
Hocam çok teşekkür ederim ellerinize sağlık.

Saygılarımla.
 
R

rhombeus

Katılım
23 Aralık 2009
Mesajlar
114
Excel Vers. ve Dili
Excel 2003
Bir sorum olacak. Müşteriyi RAPOR sayfasında combobox ile seçiyoruz. Seçtirme olayı olmadığını düşünelim. Tabloları tek tek (araya 10 satır boşluk gelecek şekilde) bütün müşteriler için yapabilirmiyiz?
 
Son düzenleme:
R

rhombeus

Katılım
23 Aralık 2009
Mesajlar
114
Excel Vers. ve Dili
Excel 2003
Yardımlarınızı ve değerli fikirlerinizi bekliyorum..
 
halit3

halit3

Uzman
Uzman
Katılım
18 Ocak 2008
Mesajlar
12,853
Excel Vers. ve Dili
2003 excell türkçe
ve
2007 excell türkçe
rhombeus' Alıntı:
Bir sorum olacak. Müşteriyi RAPOR sayfasında combobox ile seçiyoruz. Seçtirme olayı olmadığını düşünelim. Tabloları tek tek (araya 10 satır boşluk gelecek şekilde) bütün müşteriler için yapabilirmiyiz?
Genişletmek için tıkla ...
bu kodu denermisiniz.

Kod: 
Sub aktar()
Sheets("RAPOR").Rows("3:1000").ClearContents
sat1 = 3
For J = 3 To 27
aranan1 = Sheets("GENEL HAFTALIK").Cells(J, "C").Value
son = 0
For r = 3 To 27
If Sheets("RAPOR").Cells(1, "A").Value <> "" Then
If WorksheetFunction.CountIf(Worksheets("GENEL HAFTALIK").Range("C2:C" & r), aranan1) = 1 Then
For i = r To 27
sat = 2
aranan2 = Sheets("GENEL HAFTALIK").Cells(i, 3).Value
If aranan2 = aranan1 Then
Sheets("RAPOR").Cells(sat1, 1).Value = aranan1 & "  SATIŞ"
Sheets("RAPOR").Cells(sat1 + 1, 1).Value = "CH"
Sheets("RAPOR").Cells(sat1 + 2, 1).Value = "FİRMA ÇEKİ"
Sheets("RAPOR").Cells(sat1 + 3, 1).Value = "MÜŞTERİ ÇEKİ"
For n = 5 To Worksheets("GENEL HAFTALIK").Cells(2, 255).End(xlToLeft).Column
Sheets("RAPOR").Cells(sat1, sat).Value = CDbl(Sheets("RAPOR").Cells(sat1, sat).Value) + CDbl(Sheets("GENEL HAFTALIK").Cells(i, n).Value)
Sheets("RAPOR").Cells(sat1 + 1, sat).Value = CDbl(Sheets("RAPOR").Cells(sat1 + 1, sat).Value) + CDbl(Sheets("GENEL HAFTALIK").Cells(i, n + 1).Value)
Sheets("RAPOR").Cells(sat1 + 2, sat).Value = CDbl(Sheets("RAPOR").Cells(sat1 + 2, sat).Value) + CDbl(Sheets("GENEL HAFTALIK").Cells(i, n + 2).Value)
Sheets("RAPOR").Cells(sat1 + 3, sat).Value = CDbl(Sheets("RAPOR").Cells(sat1 + 3, sat).Value) + CDbl(Sheets("GENEL HAFTALIK").Cells(i, n + 3).Value)
sat = sat + 1
n = n + 3
son = 1
Next n
End If
Next i
End If
End If
Next r
If son = 1 Then
sat1 = sat1 + 10
End If
Next J
MsgBox "işlem tamam"
End Sub
 
R

rhombeus

Katılım
23 Aralık 2009
Mesajlar
114
Excel Vers. ve Dili
Excel 2003
Halit Bey Teşekkür ederim ellerinize sağlık. Yalnız bir kaç sorum olacak. Dosyamı ekledim bakabilirseniz sevinirim.
 

Ekli dosyalar

halit3

halit3

Uzman
Uzman
Katılım
18 Ocak 2008
Mesajlar
12,853
Excel Vers. ve Dili
2003 excell türkçe
ve
2007 excell türkçe
rhombeus' Alıntı:
Halit Bey Teşekkür ederim ellerinize sağlık. Yalnız bir kaç sorum olacak. Dosyamı ekledim bakabilirseniz sevinirim.
Genişletmek için tıkla ...
buı kodu denermisiniz.

Kod: 
Sub aktar()
Sheets("RAPOR").Rows("2:1000").ClearContents
sat1 = 2
For J = 3 To 28
aranan1 = Sheets("GENEL HAFTALIK").Cells(J, "C").Value
son = 0
For r = 3 To 28
If Sheets("RAPOR").Cells(1, "A").Value <> "" Then
If WorksheetFunction.CountIf(Worksheets("GENEL HAFTALIK").Range("C2:C" & r), aranan1) = 1 Then
For i = r To 28
sat = 2
aranan2 = Sheets("GENEL HAFTALIK").Cells(i, 3).Value
If aranan2 = aranan1 Then
Sheets("RAPOR").Cells(sat1, 1).Value = aranan1
Sheets("RAPOR").Cells(sat1 + 1, 1).Value = "SATIŞ"
Sheets("RAPOR").Cells(sat1 + 2, 1).Value = "CH"
Sheets("RAPOR").Cells(sat1 + 3, 1).Value = "FİRMA ÇEKİ"
Sheets("RAPOR").Cells(sat1 + 4, 1).Value = "MÜŞTERİ ÇEKİ"
Sheets("RAPOR").Cells(sat1 + 5, 1).Value = "RİSK LİMİTİ"
Sheets("RAPOR").Cells(sat1 + 6, 1).Value = "TEMİNAT"
Sheets("RAPOR").Cells(sat1 + 7, 1).Value = "RİSK"
For n = 5 To Worksheets("GENEL HAFTALIK").Cells(2, 255).End(xlToLeft).Column
Sheets("RAPOR").Cells(sat1, sat).Value = Sheets("GENEL HAFTALIK").Cells(1, n).Value
Sheets("RAPOR").Cells(sat1 + 1, sat).Value = CDbl(Sheets("RAPOR").Cells(sat1 + 1, sat).Value) + CDbl(Sheets("GENEL HAFTALIK").Cells(i, n).Value)
Sheets("RAPOR").Cells(sat1 + 2, sat).Value = CDbl(Sheets("RAPOR").Cells(sat1 + 2, sat).Value) + CDbl(Sheets("GENEL HAFTALIK").Cells(i, n + 1).Value)
Sheets("RAPOR").Cells(sat1 + 3, sat).Value = CDbl(Sheets("RAPOR").Cells(sat1 + 3, sat).Value) + CDbl(Sheets("GENEL HAFTALIK").Cells(i, n + 2).Value)
Sheets("RAPOR").Cells(sat1 + 4, sat).Value = CDbl(Sheets("RAPOR").Cells(sat1 + 4, sat).Value) + CDbl(Sheets("GENEL HAFTALIK").Cells(i, n + 3).Value)
Sheets("RAPOR").Cells(sat1 + 5, sat).Value = CDbl(Sheets("RAPOR").Cells(sat1 + 5, sat).Value) + CDbl(Sheets("GENEL HAFTALIK").Cells(i, n + 4).Value)
Sheets("RAPOR").Cells(sat1 + 6, sat).Value = CDbl(Sheets("RAPOR").Cells(sat1 + 6, sat).Value) + CDbl(Sheets("GENEL HAFTALIK").Cells(i, n + 5).Value)
Sheets("RAPOR").Cells(sat1 + 7, sat).Value = "=(-R[-2]C-R[-1]C)+R[-5]C*R5C46+R[-4]C*R6C46+R[-3]C*R7C46"
sat = sat + 1
n = n + 5
son = 1
Next n
End If
Next i
End If
End If
Next r
If son = 1 Then
sat1 = sat1 + 10
End If
Next J
MsgBox "İşleminiz Tamamlanmıştır", vbInformation, "BİLGİ"
End Sub
 
R

rhombeus

Katılım
23 Aralık 2009
Mesajlar
114
Excel Vers. ve Dili
Excel 2003
Halit bey teşekkür ederim ilginizden dolayı. Sadece tek bir problem var. Oda AT 5, 6, 7 hücrelerindeki veriler tuşa basıldığında otomatik olarak siliniyor. Nasıl düzeltebiliriz?
 
halit3

halit3

Uzman
Uzman
Katılım
18 Ocak 2008
Mesajlar
12,853
Excel Vers. ve Dili
2003 excell türkçe
ve
2007 excell türkçe
rhombeus' Alıntı:
Halit bey teşekkür ederim ilginizden dolayı. Sadece tek bir problem var. Oda AT 5, 6, 7 hücrelerindeki veriler tuşa basıldığında otomatik olarak siliniyor. Nasıl düzeltebiliriz?
Genişletmek için tıkla ...
o hücrelerdeki değerleri 1 satıra hepsini almak gerekiyor
örnek AR1,AS1,AT1 hücreleri bu 1. satır silinmiyor

diğer türlü aşağıdaki kodun yerine

Kod: 
Sheets("RAPOR").Rows("2:1000").ClearContents
bunu yaz

Kod: 
Sheets("RAPOR").Range("A2:AO5000").ClearContents
 
R

rhombeus

Katılım
23 Aralık 2009
Mesajlar
114
Excel Vers. ve Dili
Excel 2003
Olayı sayenizde tam olarak kavradım çok teşekkür ederim.
 
Cevap yazmak için giriş yap yada kayıt ol.
Üst