• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Makro ve Formül yazarak sayfalardan verı alma

K

kurthan

Katılım
25 Haziran 2008
Mesajlar
177
Excel Vers. ve Dili
2007
mrhb.arkadaşlar bu soru devlet meselesı oldu galıba
bır turlu yanıt alamadım
makro yazmayı bılmedıgım ıcın caresiz careyi siz dostlarda arıyorum
birinin de bu soruyu çözeceğine inandığım için ara sıra yeni konu olarak gönderiyorum
 

Ekli dosyalar

Hepsine ayrı ayrı formül yazmanız gerekiyor gibi ELDIVEN AMELİYAT malzemesinden ocak ayında kaç adet var hücre aralıklarını belirleyelim tamam neye göre SPARK MUTFAK TKR gibi kırmızı yazanların satır numarısına göre aylarda arasak yok biraz uğraştım başaramadım sizin branşınızı tam bilmedigimizden olabilir.
 
1-öncelikle eldiven ameliyat temizlik sayfasında bir sürü var bunun gibi aynı olarları başına kodları yazabilirsin örnek 301-eldiven ameliyat gibi bunları düzeltmen lazım.
2-"TEMİZLİK." sayfasının adını "TEMİZLİK" olarak değiştir

aşağıdaki kod bunları yaptığın zaman işlem görecektir



Kod: 
Sub aktar()
kat = 0
For r = 1 To ActiveWorkbook.Sheets.Count
If Sheets(r).Name <> "TEMİZLİK" Then
yer = Sheets(r).Name
For i = 5 To Worksheets(yer).Cells(65536, 1).End(xlUp).Row
For j = 5 To Worksheets("TEMİZLİK").Cells(65536, 1).End(xlUp).Row
If Worksheets("TEMİZLİK").Cells(j, 1).Value = Worksheets(yer).Cells(i, 1).Value Then
Worksheets("TEMİZLİK").Cells(j, 3 + kat).Value = Worksheets(yer).Cells(i, 3).Value
Worksheets("TEMİZLİK").Cells(j, 5 + kat).Value = Worksheets(yer).Cells(i, 4).Value
End If
Next j
Next i
kat = kat + 3
End If
Next r
MsgBox "işlem temem"
End Sub
 
Sayın fedeal ve halıt hocam ılgınıze çok tşk.ler
sayın halıt hocam verdıgınız kodlar ıse yarayacak sanırım
ben tuketım ambarlarının kodlarını ve urunlerın kodlarını eklı dosyada kı gıbı eklersem nasıl bır duzenleme yapmamız gerekır kodlarda
 

Ekli dosyalar

1-temizlik sayfasında A sutununa kod vermişsiniz ama basılarının kodu yok
2-aynı kodlara karşılık gelen aylar daki sayfalarında A sutununa aynı kadları vermeniz lazım yoksa bunları makro nasıl bulup ayırt edecek
 
halit hocam ben onları size örnek olsun diye yazdım
aylık olan sayfalarda raporu atarken kendisi kodları verıyo zaten
raporları tekrar cekerım olmassa
temızlık sayfasında a sutununa alsam olur mu kodları
hepsını o sekılde duzenlerım ben
 
anladım örnek olarak temizlik sayfası ve ocak sayfasına ait A sutununa kodları yaz bende makroyu ona göre düzenleyim
 
halit hocam sizin söylediğiniz şekilde en kısa zamanda ayarlayıp
göndereceğimsize şimdiden duacıyım
olursa beni büyük bir yük kurtaracaksınız
tşk.ler
 
Hamit hocam mrhb.
ben gerekli şekilde dosyayı düzenledim
ekli dosyada kontrol edebilirmisiniz acaba
istediğiniz şekilde olmuş mu
 

Ekli dosyalar

kurthan' Alıntı:
Hamit hocam mrhb.
ben gerekli şekilde dosyayı düzenledim
ekli dosyada kontrol edebilirmisiniz acaba
istediğiniz şekilde olmuş mu
Genişletmek için tıkla ...


güzel yapmışsın ancak 300058 kod eldiven ameliyat stokmalına eşit buraya kadar iyi

ama temizlik sayfasında ve diğer sayfalarda bu koddan bir tane olacak yoksa arama kodlar aynı olduğu için aktarmaların hepsi aynı oluyor

şöyle yapabilirsin kodları

örnek
300058-1
300058-2

veya

300058-a
300058-b

böyle sıralaman lazım

ondan sonra temizlik sayfasındaki eldiven ameliyat ornek olarak 300058-8 olsun bunu diğer sayfalarda bu kod varsa bunun yanınna atacaktır yoksa zaten boş kalacaktır bilmem anlata bildimmi

bunları yap bu kodu kullanabilirsin
Kod: 
Sub aktar()
sut = 0
For r = 1 To ActiveWorkbook.Sheets.Count
If Sheets(r).Name <> "TEMİZLİK" Then
yer = Sheets(r).Name
a = MsgBox(yer & "  Sayfasındaki verileri aktarmak istiyormusunuz ?", vbYesNo + vbInformation, yer)
If a = vbYes Then
For i = 5 To Worksheets(yer).Cells(65536, 1).End(xlUp).Row
For j = 5 To Worksheets("TEMİZLİK").Cells(65536, 1).End(xlUp).Row
If Worksheets(yer).Cells(i, 1).Value <> "" Then
If Worksheets("TEMİZLİK").Cells(j, 1).Value = Worksheets(yer).Cells(i, 1).Value Then
Worksheets("TEMİZLİK").Cells(j, 4 + sut).Value = Worksheets(yer).Cells(i, 4).Value
Worksheets("TEMİZLİK").Cells(j, 6 + sut).Value = Worksheets(yer).Cells(i, 5).Value
End If
End If
Next j
Next i
sut = sut + 3
End If
End If
Next r
MsgBox "işlem temem"
End Sub
 
halit hocam mrhb.
kusura kalmayın sizide bayağı meşgul ettim ama
bu şekilde devam etmem gerekiyo galiba kodları düzeltmek için
bu da uzun zaman alacak kodları tek tek düzeltmem
kısa bir yol var mı bildiğiniz kodları düzeltmek için
bul değiştir aklıma geldi ama temizlik sayfası ile uyuşmayacak
 

Ekli dosyalar

yada kırmızı ile yazılı olan tüketim yerlerinin kodlarını kullanamaz mıyız sadece
onların kodlarına göre ıkı tuketim yerinin arasında kalan veriler için makro kodu oluşturulabilinir mi acaba
 
örnek dosya gönderiyorum böyle birleştirebilirsin
 
Son düzenleme:
çok tşk.ler halit hocam ben bu şekilde tekarardan düzenleyip vermiş olduğunuz kodu kullanacağım bir sorun çıkarsa tekrardan sizi rahatsız etmek isterim
umarım rahatsız etmiş olmam
 
Halit Hocam mrhb.
her şey güzel olmuş ama kodlarda ufak bir düzenleme yapmamız gerekiyor
ben sütün eklemiştim sonradan (Pp Tutar) sutunu ondan dolayı şubat ayından sonra diğer aylara aktarırken kaymalar var birde ocak ayında olduğu gibi kırmızı ile yazan kat hizmetleri tkr tüketim yerine de veri aktarıyor
temizlik saufasında kırmızı ile yazılan tüketim yerlerine veri aktarmaması lazım
şimdiden çok tşk.ler
yeni dosya ekte
 

Ekli dosyalar

bu kodu denermisin

Kod: 
Sub aktar()
sut = 0
kat = 0
sat = Worksheets("TEMİZLİK").Cells(65536, 1).End(xlUp).Row
For r = 1 To ActiveWorkbook.Sheets.Count
If Sheets(r).Name <> "TEMİZLİK" Then
yer = Sheets(r).Name
a = MsgBox(yer & "  Sayfasındaki verileri aktarmak istiyormusunuz ?", vbYesNo + vbInformation, yer)
If a = vbYes Then
Worksheets("TEMİZLİK").Range(Cells(5, 4 + kat), Cells(sat, 4 + kat)).ClearContents
Worksheets("TEMİZLİK").Range(Cells(5, 6 + kat), Cells(sat, 6 + kat)).ClearContents
For i = 5 To Worksheets(yer).Cells(65536, 1).End(xlUp).Row
For j = 5 To Worksheets("TEMİZLİK").Cells(65536, 1).End(xlUp).Row
If Worksheets(yer).Cells(i, 1).Value <> "" Then
If Worksheets(yer).Cells(i, 1).Font.ColorIndex <> 3 Then
If Worksheets("TEMİZLİK").Cells(j, 1).Value = Worksheets(yer).Cells(i, 1).Value Then
Worksheets("TEMİZLİK").Cells(j, 4 + sut).Value = Worksheets(yer).Cells(i, 4).Value
Worksheets("TEMİZLİK").Cells(j, 6 + sut).Value = Worksheets(yer).Cells(i, 5).Value
End If
End If
End If
Next j
Next i
sut = sut + 4
End If
kat = kat + 4
End If
Next r
MsgBox "işlem temem"
End Sub
kurthan' Alıntı:
Halit Hocam mrhb.
her şey güzel olmuş ama kodlarda ufak bir düzenleme yapmamız gerekiyor
ben sütün eklemiştim sonradan (Pp Tutar) sutunu ondan dolayı şubat ayından sonra diğer aylara aktarırken kaymalar var birde ocak ayında olduğu gibi kırmızı ile yazan kat hizmetleri tkr tüketim yerine de veri aktarıyor
temizlik saufasında kırmızı ile yazılan tüketim yerlerine veri aktarmaması lazım
şimdiden çok tşk.ler
yeni dosya ekte
Genişletmek için tıkla ...
 
Halit hocam mrhb.
bir önceki kodda sutun sayısı 3 olanı 4 yaptım bır de temızlık dosyası ve aylık tuketım dosyalarında kırmızı ıle yazan tuketım yerlerının basında kı kod numarasını kaldırıp denedım oldu bır soru cıkmadı
ben baska bır soru sorabılır mıyım
1-aylık tuketımler ağustos a kadardı ben bunu kalan üç ayın raporunu cektıgım zaman basındakı kodları da duzenleyıp makroyu çalıştırdığım zaman aktarma da bir sorun olur mu
2-temizlik dosyası gıbı daha 8 dosyam var yazmış olduğunuz kodda sadece temizlik ismini değiştirip mesela diğer dosya olan müşteri dosyasının ismini yazsam ve sistemden çekmiş olduğum raporların da kodlarını düzenlesem,aynı zamanda satırlar değişebilir bu işlemler sonucu makroyu sorunsuz çalıştırabilir miyim?
sorum çok uzun oldu kusura bakmayın
çok çok sağolun varolun
 
bir sorun olmaz ben sayfa ismini rahat değiştirmen için sayfa_adı yazan yere TEMİZLİK yazdım bunu değiştirirsen yeterli
ayrıca bölme ve yuvarlama işlemlerinide yapıyor formüle gerek kalmadı


Sub aktar()
sayfa_adı = "TEMİZLİK"
sut = 0
kat = 0
sat = Worksheets(sayfa_adı).Cells(65536, 1).End(xlUp).Row
For r = 1 To ActiveWorkbook.Sheets.Count
If Sheets(r).Name <> sayfa_adı Then
yer = Sheets(r).Name
a = MsgBox(yer & " Sayfasındaki verileri aktarmak istiyormusunuz ?", vbYesNo + vbInformation, yer)
If a = vbYes Then
Worksheets(sayfa_adı).Range(Cells(5, 4 + kat), Cells(sat, 6 + kat)).ClearContents
'Worksheets("TEMİZLİK").Range(Cells(5, 6 + kat), Cells(sat, 6 + kat)).ClearContents
For i = 5 To Worksheets(yer).Cells(65536, 1).End(xlUp).Row
For j = 5 To Worksheets("TEMİZLİK").Cells(65536, 1).End(xlUp).Row
If Worksheets(yer).Cells(i, 1).Value <> "" Then
If Worksheets("TEMİZLİK").Cells(j, 1).Font.Bold = False Then
If Worksheets(sayfa_adı).Cells(j, 1).Font.ColorIndex = 1 Then
If Worksheets(sayfa_adı).Cells(j, 1).Value = Worksheets(yer).Cells(i, 1).Value Then
Worksheets(sayfa_adı).Cells(j, 4 + sut).Value = Round(Worksheets(yer).Cells(i, 4).Value, 2)
Worksheets(sayfa_adı).Cells(j, 6 + sut).Value = Round(Worksheets(yer).Cells(i, 5).Value, 2)
Worksheets(sayfa_adı).Cells(j, 5 + sut).Value = Round((Worksheets(yer).Cells(i, 5).Value / Worksheets(yer).Cells(i, 4).Value), 2)
End If
End If
End If
End If
Next j
Next i
End If
sut = sut + 4
kat = kat + 4
End If
Next r
MsgBox "işlem temem"
End Sub
Genişletmek için tıkla ...
 
Son düzenleme:
halit hocam beni büyük bir uğraştan kurtardınız
allah razı olsun
allah sizin de her konuda yardımcınız olur inşallah
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst