Arama butonu
Bu konudaki kullanıcılar: 1 misafir
1
Cevap
10397
Tıklama
0
Öne Çıkarma
Excel'de yan sayfadan otomatik veri almak.
E
19 yıl
Er
Konu Sahibi

Selam arkadaşlar.


Excel'de benim bir çalışma yapmam gerekiyor.
Yardımcı olabileceklere şimdiden çok teşekkür ederim.
Temel Korkmaz'ın kitabını da karıştırdım ama, benzer örnek bulamadım.

TOPLAM sayfasındaki A sütununda 1000 adet stok kodu var.

RAPOR sayfasında da, aylık satış raporu olarak A sütununda stok kodu, B sütununda ADET, C sütununda da TUTAR var. Satır sayısı en az 1, en çok 1000 adet olabilir.

TOPLAM sayfasının B ve C sütunlarına, RAPOR sayfasındaki A sütünunda bulunan stok kodlarına ait olan B sütunundaki ADET ve C sütunundaki TUTAR'lar girilecek.

RAPOR sayfasındaki stok kodlarını tek tek TOPLAM sayfasında bulup satış adet ve tutarlarını soldaki sayfanın sütunlarına elle girmek yerine otomatik nasıl aktarabilirim?

Şimdiden çok teşekkür ediyorum.

Hoşçakalın.
Erdal Demir

DH forumlarında vakit geçirmekten keyif alıyor gibisin ancak giriş yapmadığını görüyoruz.

Üye olduğunda özel mesaj gönderebilir, beğendiğin konuları favorilerine ekleyip takibe alabilir ve daha önce gezdiğin konulara hızlıca erişebilirsin.

Üye Ol Şimdi Değil



E
19 yıl
Er
Konu Sahibi

BİRİLERİNİN İŞİNE YARAYABİLİR,

ANA_LISTE sayfasında A sütununda 10000 stok kodları var. B ve C sütunlarına, AYLIK RAPOR sayfasında bulunan o aya ait satışları, uygun stok kodları yanına aktaracak.

Eğer ANA_LISTE sayfasında olmayan bir stok kodu AYLIK_RAPOR sayfasında varsa, HATALAR adına sahip sayfaya stok kodunu ve yanındaki 2 sütunun bilgisini yazacak.

SORU SORMAYIN, BAŞKASINA YAPTIRDIM.


Sub RaporGir()

Dim RaporSayfasi, AnaListeSayfasi, KayitSayisi

RaporSayfasi = "AYLIK_RAPOR" ' Okunacak dataların bulunduğu sayfanın adı
AnaListeSayfasi = "ANA_LISTE" ' Yazılacak sayfanın adı
HataSayfasi = "HATALAR" ' Sonradan Stok Kodu Eklenmişse, Yazılacak sayfanın adı
Const IlkSatir = 2 ' Kayıtların bulunduğu sayfada kodların bulunduğu ilk satır
Const SonSatir = 100 ' Kayıtların bulunduğu sayfanın satır sayısı

Dim Kodlar(1 To SonSatir) As String
Dim Miktarlar(1 To SonSatir) As Double
Dim Tutarlar(1 To SonSatir) As Double
Dim Okunanlar(1 To SonSatir) As Integer
KayitSayisi = 1

Sheets(RaporSayfasi).Select
For i = IlkSatir To SonSatir
Hucre1 = "A" & i ' Kod no bu değişkenle okunacak. İlk kayıt okunurken Hucre1 = "A2" olacak
Hucre2 = "B" & i ' Miktar bilgisi bu değişkenle okunacak
Hucre3 = "C" & i ' Tutar bilgisi bu değişkenle okunacak

Kod = Worksheets(RaporSayfasi).Range(Hucre1) ' A2 deki kod okunup Kod değişkenine saklanacak
Miktar = Worksheets(RaporSayfasi).Range(Hucre2) ' B2 deki kod okunup Miktar değişkenine saklanacak
Tutar = Worksheets(RaporSayfasi).Range(Hucre3) ' C2 deki kod okunup Tutar değişkenine saklanacak
Mevcut = 0
For j = 1 To KayitSayisi - 1 ' Bu kod daha önce okunmuş mu, bakılacak
If Kodlar(j) = Kod Then ' Bu kod daha önce var ise
Miktarlar(j) = Miktarlar(j) + Miktar ' Toplamın üstüne ekle
Tutarlar(j) = Tutarlar(j) + Tutar
Mevcut = 1
End If
Next j
If Mevcut = 0 Then ' Bu kod daha önce okunmamışsa
Kodlar(KayitSayisi) = Kod ' Kayıtlara ilave edilecek
Miktarlar(KayitSayisi) = Miktar
Tutarlar(KayitSayisi) = Tutar
KayitSayisi = KayitSayisi + 1
End If
Next i

For i = 1 To KayitSayisi
Okunanlar(i) = 0
Next i

' ANA_LISTE sayfasına yazdırma bölümü

Sheets(AnaListeSayfasi).Select ' ANA_LISTE sayfasına geç

BaslangicSatiri = 2 ' 3. satırdan başlaması için bir satır boşluk verecek
RaporSatiri = 10000
For i = 1 To RaporSatiri
Hucre1 = "A" & i + BaslangicSatiri
Hucre2 = "E" & i + BaslangicSatiri
Hucre3 = "F" & i + BaslangicSatiri
Kod = Worksheets(AnaListeSayfasi).Range(Hucre1).Value
If Kod = "" Then GoTo Satir
For j = 1 To KayitSayisi
If Kod = Kodlar(j) Then
Worksheets(AnaListeSayfasi).Range(Hucre2).Value = Miktarlar(j)
Worksheets(AnaListeSayfasi).Range(Hucre3).Value = Tutarlar(j)
Okunanlar(j) = 1
GoTo Satir
End If
Next j

Satir:

Next i

Sheets(HataSayfasi).Select ' HATALAR sayfasına geç
Range("A1:G100").Select ' A1:G1000 arasını işaretle
Selection.ClearContents ' Seçilen alanı sil, eskiden kalan data olmasın

k = 2
For m = 1 To KayitSayisi
If Okunanlar(m) = 0 Then
Hucre1 = "A" & k + BaslangicSatiri
Hucre2 = "B" & k + BaslangicSatiri
Hucre3 = "C" & k + BaslangicSatiri
Worksheets(HataSayfasi).Range(Hucre1).Value = Kodlar(m)
Worksheets(HataSayfasi).Range(Hucre2).Value = Miktarlar(m)
Worksheets(HataSayfasi).Range(Hucre3).Value = Tutarlar(m)
k = k + 1
End If
Next m
End Sub



DH Mobil uygulaması ile devam edin. Mobil tarayıcınız ile mümkün olanların yanı sıra, birçok yeni ve faydalı özelliğe erişin. Gizle ve güncelleme çıkana kadar tekrar gösterme.