Excel Forum
ALTIN ÜYELİK Hakkında Bilgi


Geri Git   Excel Forum > EXCEL-Soruları > Makro-VBA
Atatürk
Şifremi Unuttum

DUYURU SİSTEMİ / REKLAM PANOSU

Makro-VBA Makro veya VBA ile ilgili sorularınızı buraya gönderebilirsiniz.
Dosya ekleyebilirsiniz

Özel Arama


Yanıtla
 
Paylaş Konu Araçları Görünüm Modları
Eski 06-12-2017, 21:39   #11
Ziynettin
Altın Üye
 
Giriş: 17/04/2008
Şehir: istanbul
Mesaj: 421
Excel Vers. ve Dili:
office2010
Varsayılan

Alıntı:
ASLAN7410 tarafından gönderildi Mesajı Görüntüle
Sayın askm, yazmış olduğunuz kod gayet güzel çalışıyor, elinize sağlık,
çok teşekkür ediyorum.

Ben bu kodu bir kaç sayfa için yapmaya çalıştığım zaman aktardığı yere
sadece bir sayfayı aktarıyor, bütün sayfalar için ayarlayabilir misiniz?
.


Kod: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
Sub listele()
Dim a(), b(), sh As Worksheet, j As Byte, görev As String
Dim i As Long, n As Long, Say As Long, son As Long
Dim y As Byte, z As Double
z = TimeValue(Now)
For j = 1 To Sheets.Count
    Set sh = Sheets(j)
    If Not sh.Name = "ÇALIŞMA" Then
        son = sh.Cells(Rows.Count, 3).End(3).Row
        a = sh.Range("B9:E" & son)
        For i = 1 To UBound(a)
            If a(i, 2) <> "" Then n = n + 1
        Next i
    End If
Next j

'*******************************
ReDim b(1 To n, 1 To 5)
For j = 1 To Sheets.Count
    Set sh = Sheets(j)
    If Not sh.Name = "ÇALIŞMA" Then
        son = sh.Cells(Rows.Count, 3).End(3).Row
        a = sh.Range("B9:E" & son)
        görev=""
        For i = 1 To UBound(a)
            If Not IsNumeric(a(i, 1)) Then
                görev = a(i, 1)
            End If
            If a(i, 2) <> "" Then
                Say = Say + 1
                For y = 1 To 4
                    b(Say, y) = a(i, y)
                Next y
                b(Say, 5) = görev
            End If
        Next i
    End If
Next j

Sheets("ÇALIŞMA").Range("B2:F" & Rows.Count).ClearContents
Sheets("ÇALIŞMA").[B2].Resize(Say, 5) = b
MsgBox "İşlem Tamam." & vbLf & vbLf & "İşlem sureniz :  " & _
        CDate(TimeValue(Now) - z), vbInformation
End Sub

Bu mesaj en son " 06-12-2017 " tarihinde saat 22:57 itibariyle Ziynettin tarafından düzenlenmiştir....
Ziynettin Çevrimdışı   Alıntı Yaparak Cevapla
Eski 06-12-2017, 21:43   #12
ASLAN7410
Altın Üye
 
ASLAN7410 kullanıcısının avatarı
 
Giriş: 15/07/2012
Şehir: Aslan ERASLAN - ANKARA
Mesaj: 1,574
Excel Vers. ve Dili:
Ofis 2013 Türkçe
Varsayılan

Sayın Ziynettin Bey, ellerinize sağlık kod güzel çalışıyor, ancak sayfalardaki rütbe kısmını aktarmıyor.
__________________
.
Her zaman yardımcı olmak güzel bir şeydir...
ASLAN7410 Çevrimdışı   Alıntı Yaparak Cevapla
Eski 06-12-2017, 21:48   #13
Ziynettin
Altın Üye
 
Giriş: 17/04/2008
Şehir: istanbul
Mesaj: 421
Excel Vers. ve Dili:
office2010
Varsayılan

Gerekli düzeltmeler yapıldı. Tekrar deneyiniz.
Ziynettin Çevrimdışı   Alıntı Yaparak Cevapla
Eski 06-12-2017, 21:56   #14
ASLAN7410
Altın Üye
 
ASLAN7410 kullanıcısının avatarı
 
Giriş: 15/07/2012
Şehir: Aslan ERASLAN - ANKARA
Mesaj: 1,574
Excel Vers. ve Dili:
Ofis 2013 Türkçe
Varsayılan

Sayın Ziynettin Bey, kod sayfa1'i güzel aktarıyor, Sayfa2 ve Sayfa3'teki 1.ve 2. sıradaki
personelin karşısında herhangi bir görev yeri yazmıyor, bunları bu şekilde aktarması gerekiyor.

Butona bastığımda bu görevlilerin karşısına da görev yeri atıyor.
__________________
.
Her zaman yardımcı olmak güzel bir şeydir...
ASLAN7410 Çevrimdışı   Alıntı Yaparak Cevapla
Eski 06-12-2017, 22:54   #15
Ziynettin
Altın Üye
 
Giriş: 17/04/2008
Şehir: istanbul
Mesaj: 421
Excel Vers. ve Dili:
office2010
Varsayılan

Kodu tekrar deneyin. görev="" satırı eklendi.
Ziynettin Çevrimdışı   Alıntı Yaparak Cevapla
Eski 06-12-2017, 23:00   #16
ASLAN7410
Altın Üye
 
ASLAN7410 kullanıcısının avatarı
 
Giriş: 15/07/2012
Şehir: Aslan ERASLAN - ANKARA
Mesaj: 1,574
Excel Vers. ve Dili:
Ofis 2013 Türkçe
Varsayılan

Sayın Ziynettin Bey, maalesef istediğim sonucu alamadım.
__________________
.
Her zaman yardımcı olmak güzel bir şeydir...
ASLAN7410 Çevrimdışı   Alıntı Yaparak Cevapla
Eski 06-12-2017, 23:03   #17
ASLAN7410
Altın Üye
 
ASLAN7410 kullanıcısının avatarı
 
Giriş: 15/07/2012
Şehir: Aslan ERASLAN - ANKARA
Mesaj: 1,574
Excel Vers. ve Dili:
Ofis 2013 Türkçe
Varsayılan

Sayın Ziynettin Bey, ekte gönderdiğim excel dosyasında sizin yazmış olduğunuz kod var,
butona bastığımda istediğim sonucu alamıyorum.
.
Eklenmiş Dosyalar
Dosya Türü: xlsm GÖREV1.xlsm (41.4 KB, 6 Görüntülenme)
__________________
.
Her zaman yardımcı olmak güzel bir şeydir...
ASLAN7410 Çevrimdışı   Alıntı Yaparak Cevapla
Eski 06-12-2017, 23:45   #18
Ziynettin
Altın Üye
 
Giriş: 17/04/2008
Şehir: istanbul
Mesaj: 421
Excel Vers. ve Dili:
office2010
Varsayılan

Kodu tekrar deneyiniz. görev="" kod satırını yanlış satıra yazılmışım.
Ziynettin Çevrimdışı   Alıntı Yaparak Cevapla
Eski 07-12-2017, 00:02   #19
ASLAN7410
Altın Üye
 
ASLAN7410 kullanıcısının avatarı
 
Giriş: 15/07/2012
Şehir: Aslan ERASLAN - ANKARA
Mesaj: 1,574
Excel Vers. ve Dili:
Ofis 2013 Türkçe
Varsayılan

Sayın Ziynettin Bey, şimdi oldu ellerinize sağlık, çok teşekkür ediyorum.

Hayırlı geceler, hayırlı çalışmalar diliyorum.
__________________
.
Her zaman yardımcı olmak güzel bir şeydir...
ASLAN7410 Çevrimdışı   Alıntı Yaparak Cevapla
Yanıtla


Konu Araçları
Görünüm Modları

Gönderme Kuralları
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts

BB code is Açık
SimgelerAçık
[IMG] kodu Açık
HTML kodu Kapalı


Saat 11:51


Bu forum Elit NET - www.elitnet.com.tr tarafından sunulmaktadır.

Excel Eğitimi - Mobil Uygulama - Çorlu - Çorlu Web Tasarım -- Beylikdüzü mali müşavir - Lingerie - Dyeing Machine - Karton Bardak- Çorlu Özel Eğitim- Site Yönetimi- Pronet Tekirdağ- Çorlu Kamera- Pronet Edirne- Pronet Kırklareli- Pronet Çerkezköy- Pronet Çorlu- Pronet Lüleburgaz- Pronet Keşan- Çorlu Araç Takip- Çorlu Su Arıtma- Gebze Emlak- Bakır Sülfat- Rampa- Rotary- Çorlu İnternet Sitesi- youngblood- Çorlu Sürücü Kursu- Çorlu Sandviç Panel- Şişli Avukat- Korona Test Kalemi- Çorlu Vinç- Çorlu Pimapen Tamiri- Çorlu Çelik Konstruksiyon- Çorlu Dans- Edirne Serbest Muhasebeci- Çorlu Etüt- İstanbul Botanik- Çorlu Sigorta-
Powered by vBulletin Version 3.7.2
Copyright ©2000 - 2017, Jelsoft Enterprises Ltd.
Advertisement System V2.6 By   Branden