[Yardım]  Excel Sevk fisi

VBA Makrolar ile ilgili sormak istedikleriniz, yapmak istedikleriniz hakkında yardım alabileceğiniz bölümdür.

Excel Sevk fisi

İleti#1)  tarkandeliyurek » 09 Ekm 2018 15:34

Merhaba.

Kömür Madeninde kantardan çıkan kamyonlara vermek üzere TKİ ye ait matbu kömür fişi var. Kantardaki personelin basit şekilde kullanması için EK'te gönderdiğim Excel sayfasını doldurup nokta vuruşlu yazıcıyla A5 formatında ki bu forma basıyorum. Excel'de ki hücreleri matbu sevk fişinde ilgili yerlere denk gelecek şekilde ayarladım.

Yapmak istediğim SEVKFISI yazan çalışma sayfasında Kırmızı ile girilen tüm bilgi ve metinlerin ayrı bir çalışma sayfasında (mesela RAPORLAR) alt alta liste halinde aktarılması ve kaydetmesi. Geçmişe dönük raporlama ve filtreleme yapabilmek istiyoruz. Hangi gün hangi araçlar çıkmış vb. Yardımcı olursanız çok minnettar olurum.
Bu iletideki ekleri görmek için gerekli yetkilere sahip değilsiniz.
Kullanıcı avatarı
tarkandeliyurek
 
Kayıt: 11 Oca 2018 17:52
Meslek: Bilgisayar Tek.
Yaş: 42
İleti: 9
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Ankara

Cevap: Excel Sevk fisi

İleti#2)  AhmetRasim » 10 Ekm 2018 00:03

Merhabalar;
Örnek olarak şu kodlar ile kayıt yapabilirsiniz.
Kod: Tümünü seç
Sub aktar()
Dim s1 As Worksheet
Dim s2 As Worksheet

Set s1 = Worksheets("SEVK FISI")
Set s2 = Worksheets("RAPOR")

Application.ScreenUpdating = False
a = s2.Cells(Rows.Count, "A").End(3).Row + 1
b = s2.Cells(Rows.Count, "B").End(3).Row + 1
c = s2.Cells(Rows.Count, "C").End(3).Row + 1
d = s2.Cells(Rows.Count, "D").End(3).Row + 1
e = s2.Cells(Rows.Count, "E").End(3).Row + 1
f = s2.Cells(Rows.Count, "F").End(3).Row + 1
g = s2.Cells(Rows.Count, "G").End(3).Row + 1
h = s2.Cells(Rows.Count, "H").End(3).Row + 1
i = s2.Cells(Rows.Count, "I").End(3).Row + 1
j = s2.Cells(Rows.Count, "J").End(3).Row + 1
k = s2.Cells(Rows.Count, "K").End(3).Row + 1
l = s2.Cells(Rows.Count, "L").End(3).Row + 1
m = s2.Cells(Rows.Count, "M").End(3).Row + 1
n = s2.Cells(Rows.Count, "N").End(3).Row + 1
o = s2.Cells(Rows.Count, "O").End(3).Row + 1
p = s2.Cells(Rows.Count, "P").End(3).Row + 1

s2.Cells(a, "A").Value = s1.Range("I2").Value
s2.Cells(a, "B").Value = s1.Range("I3").Value
s2.Cells(a, "C").Value = s1.Range("D5").Value
s2.Cells(a, "D").Value = s1.Range("D8").Value
s2.Cells(a, "E").Value = s1.Range("D9").Value
s2.Cells(a, "F").Value = s1.Range("I9").Value
's2.Cells(a, "G").Value = s1.Range("D11").Value
's2.Cells(a, "H").Value = s1.Range("D14").Value
's2.Cells(a, "I").Value = s1.Range("I14").Value
's2.Cells(a, "J").Value = s1.Range("A17").Value
s2.Cells(a, "K").Value = s1.Range("D17").Value
s2.Cells(a, "L").Value = s1.Range("G17").Value
s2.Cells(a, "M").Value = s1.Range("I17").Value
s2.Cells(a, "N").Value = s1.Range("D18").Value
s2.Cells(a, "O").Value = s1.Range("D19").Value
s2.Cells(a, "P").Value = s1.Range("D21").Value
Application.ScreenUpdating = True
End Sub

G-H-I-J sütunlarında Veri doğrulama ile açılır liste olduğu için ilgili satırların başına tek tırnak işareti ( ' ) ekledim.

-Açılır listeyi kullanacaksanız, bu satırlar pasif kalmalı.
-Açılır listeyi kullanmayacaksanız, Veri doğrulamayı ilgili bölümlerden iptal edip, satır başlarında bulunan tek tırnak işaretlerini de silmeniz gerekmektedir, bu şekilde ilgili satırlar aktif olur.
-Sütun başlıklarından filtre eklerseniz, kayıtlar eklendikçe filtre yapabilirsiniz.
Kullanıcı avatarı
AhmetRasim
Site Dostu
 
Adı Soyadı:Ahmet Rasim
Kayıt: 20 Kas 2013 23:40
Konum: İstanbul
Meslek: Serbest
Yaş: 32
İleti: 1036
 
Cinsiyet: Bay

Cevap: Excel Sevk fisi

İleti#3)  AhmetRasim » 10 Ekm 2018 00:23

Kodlarda bulunan şu satırları kaldırabilirsiniz, tanımlama yaptım ancak kod içinde kullanmadım, eklerken kaldırmayı unutmuşum kusura bakmayın.
Kod: Tümünü seç
b = s2.Cells(Rows.Count, "B").End(3).Row + 1
c = s2.Cells(Rows.Count, "C").End(3).Row + 1
d = s2.Cells(Rows.Count, "D").End(3).Row + 1
e = s2.Cells(Rows.Count, "E").End(3).Row + 1
f = s2.Cells(Rows.Count, "F").End(3).Row + 1
g = s2.Cells(Rows.Count, "G").End(3).Row + 1
h = s2.Cells(Rows.Count, "H").End(3).Row + 1
i = s2.Cells(Rows.Count, "I").End(3).Row + 1
j = s2.Cells(Rows.Count, "J").End(3).Row + 1
k = s2.Cells(Rows.Count, "K").End(3).Row + 1
l = s2.Cells(Rows.Count, "L").End(3).Row + 1
m = s2.Cells(Rows.Count, "M").End(3).Row + 1
n = s2.Cells(Rows.Count, "N").End(3).Row + 1
o = s2.Cells(Rows.Count, "O").End(3).Row + 1
p = s2.Cells(Rows.Count, "P").End(3).Row + 1
Kullanıcı avatarı
AhmetRasim
Site Dostu
 
Adı Soyadı:Ahmet Rasim
Kayıt: 20 Kas 2013 23:40
Konum: İstanbul
Meslek: Serbest
Yaş: 32
İleti: 1036
 
Cinsiyet: Bay

Cevap: Excel Sevk fisi

İleti#4)  tarkandeliyurek » 10 Ekm 2018 13:33

Sayın Ahmet Rasim Bey,

Allah Razı olsun. Çok güzel çalışıyor.

Sadece Kod 'da Application.ScreenUpdating = True yazılı omasına rağmen bilgileri SEVKFISI çalışma sayfasına girdikten sonra RAPOR 'a direkt aktarmıyor. Makroyu manuel olarak Çalıştır yapınca aktarıyor. Excel hızlı erişim çubuğuna kısayol yaptım. Olmazsa Makro Run komutunu çalıştırmak için UserForm dan Textbox düğme ekleyebilirmiyiz. Teşekkürler.
Kullanıcı avatarı
tarkandeliyurek
 
Kayıt: 11 Oca 2018 17:52
Meslek: Bilgisayar Tek.
Yaş: 42
İleti: 9
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Ankara

REKLAM
Excel Logo XML Oluşturucu
Logo Object Designer ile Uyarlama

Cevap: Excel Sevk fisi

İleti#5)  AhmetRasim » 10 Ekm 2018 20:54

Merhabalar;
Amin! Cümlemizden razı olur inşallah, teşekkür ederim. [mersi]

Kodları şu şekilde de kullanabilirsiniz.

Kodların çalışması için SEVK FISI sayfasında Taşıt Plaka Numarası yani D21 hücresine giriş yapmanız gerekmektedir. Eğer plaka numarası değişmeyecek ise, hücreye çift tıklayınız, hücrede imleç aktif olunca Enter ile hücreden çıkınız. Böyle yapmamdaki sebep, her hücreye veri girdiğinizde RAPOR sayfasına aktarmaması için.

Yani If Intersect(Target, Range("D21")) Is Nothing Then Exit Sub bu satır ile D21 hücresi makroyu çalıştıracak olan yer olmuş oldu.

SEVK FISI sekmesinde Sağ Tuş\Kod Görüntüle yi tıklayınız ve açılan sayfaya bu kodları yapıştırınız.
Kod: Tümünü seç
Private Sub Worksheet_Change(ByVal Target As Range)
Dim s1 As Worksheet
Dim s2 As Worksheet

Set s1 = Worksheets("SEVK FISI")
Set s2 = Worksheets("RAPOR")

Application.ScreenUpdating = False
If Intersect(Target, Range("D21")) Is Nothing Then Exit Sub
a = s2.Cells(Rows.Count, "A").End(3).Row + 1

s2.Cells(a, "A").Value = s1.Range("I2").Value
s2.Cells(a, "B").Value = s1.Range("I3").Value
s2.Cells(a, "C").Value = s1.Range("D5").Value
s2.Cells(a, "D").Value = s1.Range("D8").Value
s2.Cells(a, "E").Value = s1.Range("D9").Value
s2.Cells(a, "F").Value = s1.Range("I9").Value
s2.Cells(a, "G").Value = s1.Range("D11").Value
s2.Cells(a, "H").Value = s1.Range("D14").Value
s2.Cells(a, "I").Value = s1.Range("I14").Value
s2.Cells(a, "J").Value = s1.Range("A17").Value
s2.Cells(a, "K").Value = s1.Range("D17").Value
s2.Cells(a, "L").Value = s1.Range("G17").Value
s2.Cells(a, "M").Value = s1.Range("I17").Value
s2.Cells(a, "N").Value = s1.Range("D18").Value
s2.Cells(a, "O").Value = s1.Range("D19").Value
s2.Cells(a, "P").Value = s1.Range("D21").Value
Application.ScreenUpdating = True

End Sub
Kullanıcı avatarı
AhmetRasim
Site Dostu
 
Adı Soyadı:Ahmet Rasim
Kayıt: 20 Kas 2013 23:40
Konum: İstanbul
Meslek: Serbest
Yaş: 32
İleti: 1036
 
Cinsiyet: Bay

Cevap: Excel Sevk fisi

İleti#6)  tarkandeliyurek » 12 Ekm 2018 17:41

Tekrar Teşekkür ediyorum Ahmet Bey.
Bende kullananlara kolaylık olsun diye Sevk fişi çalışma sayfasına Kaydet ve Yazdır diye bir Form Denetimi buton ekleyip kod yazdım.
Kullanıcı avatarı
tarkandeliyurek
 
Kayıt: 11 Oca 2018 17:52
Meslek: Bilgisayar Tek.
Yaş: 42
İleti: 9
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Ankara

REKLAM
ETA - Excel Konsolide Raporlama
ETA Excel Personel Entegre Raporu

Cevap: Excel Sevk fisi

İleti#7)  AhmetRasim » 12 Ekm 2018 17:45

Merhabalar;
Rica ederim, elinize sağlık.
Saygılarımla, iyi çalışmalar. --)(
Kullanıcı avatarı
AhmetRasim
Site Dostu
 
Adı Soyadı:Ahmet Rasim
Kayıt: 20 Kas 2013 23:40
Konum: İstanbul
Meslek: Serbest
Yaş: 32
İleti: 1036
 
Cinsiyet: Bay


Forum Genel Makro Soruları

Online Kullanıcılar

Bu forumu görüntüleyenler: Kayıtlı kullanıcı yok ve 3 misafir

cron
Bumerang - Yazarkafe