Zirve Aktarma

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

Zirve Aktarma

İleti#1)  emiroglu07 » 18 Mar 2020 10:01

Listedeki kayıtları zirve sayfasına aktarmak için nasıl bir yol izleye bilirim. [ilginc]
Bu iletideki ekleri görmek için gerekli yetkilere sahip değilsiniz.
Kullanıcı avatarı
emiroglu07
Site Dostu
 
Adı Soyadı:AHMET
Kayıt: 07 Oca 2014 16:36
Konum: İSTANBUL
Meslek: TEKSTİL
Yaş: 33
İleti: 543
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: DİDİM

Cevap: Zirve Aktarma

İleti#2)  emiroglu07 » 18 Mar 2020 11:34

Kod: Tümünü seç
Sub aktar()
    Set sL = Sheets("LİSTE")
    Set sZ = Sheets("ZİRVE")
    sZ.Range("2:" & Rows.Count).ClearContents
    sat = 2
    For i = 2 To 32
        kod = sL.Cells(i, "A")
        tar = sL.Cells(i, "B")
        evrNo = sL.Cells(i, "C")
        bt = sL.Cells(i, "D")
        vrno = sL.Cells(i, "E")
        acklm = sL.Cells(i, "F")
            For ii = 3 To 18
            toplam = sL.Cells(i, ii)
            If toplam > 0 Then
                sZ.Cells(sat, 1) = kod
                sZ.Cells(sat, 2) = tar
                sZ.Cells(sat, 3).NumberFormat = "@"
                sZ.Cells(sat, 3) = Format(evrNo, "0")
                sZ.Cells(sat, 4) = bt
                sZ.Cells(sat, 5) = vrno
                sZ.Cells(sat, 6) = acklm
                sZ.Cells(sat, 7) = sL.Cells(6, ii)
                sZ.Cells(sat, 1) = sL.Cells(7, ii)
                sZ.Cells(sat, 1) = sL.Cells(8, ii)
                sZ.Cells(sat, 1) = sL.Cells(9, ii)
                If ii < 10 And sL.Cells(i, ii + 17) > 0 Then
                     sZ.Cells(sat, 12) = sL.Cells(i, ii + 17)
                End If
                sat = sat + 1
            End If
        Next ii
    Next i
End Sub

üstadlar buraya kadar getirdim devamını yapamadım bi destek atsanız.
Kullanıcı avatarı
emiroglu07
Site Dostu
 
Adı Soyadı:AHMET
Kayıt: 07 Oca 2014 16:36
Konum: İSTANBUL
Meslek: TEKSTİL
Yaş: 33
İleti: 543
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: DİDİM

Cevap: Zirve Aktarma

İleti#3)  emiroglu07 » 18 Mar 2020 16:44

Üstadlar Son satır kayıtlarında destek olabilirmisiniz.
Kullanıcı avatarı
emiroglu07
Site Dostu
 
Adı Soyadı:AHMET
Kayıt: 07 Oca 2014 16:36
Konum: İSTANBUL
Meslek: TEKSTİL
Yaş: 33
İleti: 543
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: DİDİM

Cevap: Zirve Aktarma

İleti#4)  Miraç CAN » 19 Mar 2020 14:45

Ben emin değilim yazdıklarınızın doğru sonuç vereceğine?
Liste sayfasında ki tarih verisini, hesap kodu sütununa yaz gibi hatalar yapmışsınız.
Tamamen kaydırma yapmışsınız :)
ikinci döngünüz de yanlış.
Bazı yerlerde de satır/sütun yerlerini sL.Cells(9, ii) yanlış yazmışsınız sanırım.
Sanırım diyorum çünkü, hiç bir açıklama yapmamışsınız. Ekli dosyanızda da bir açıklama yok.

Birkaç açıklama yapsaydınız da zaman ayırmışken yardımcı olmaya çalışabilmiş olsaydık.
Kullanıcı avatarı
Miraç CAN
Siteye Alışmış
 
Kayıt: 26 Arl 2016 19:07
Meslek: Harita/Ölçme
Yaş: 38
İleti: 417
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Amasya\Adana

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

Cevap: Zirve Aktarma

İleti#5)  emiroglu07 » 20 Mar 2020 09:17

Meriç bey öncelikle zaman ayırıp ilgilendiğiniz için çok teşekkür ederim.
Konuyu açıkça belirtmemek benim kabahatimdir.Kusura bakmayın. Açıkçası yapmak istediğim liste sayfasındaki bir satırı zirve sayfasına 4 ayrı madde halinde aktarmaktır.
Resimde de göreceğiniz gibi 108 ve 100 ler borç sutununa 391 ve 600 leri alacak stununa gelecek şekilde aktarmak istemiştim ama beceremedim.
Bu iletideki ekleri görmek için gerekli yetkilere sahip değilsiniz.
Kullanıcı avatarı
emiroglu07
Site Dostu
 
Adı Soyadı:AHMET
Kayıt: 07 Oca 2014 16:36
Konum: İSTANBUL
Meslek: TEKSTİL
Yaş: 33
İleti: 543
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: DİDİM

Cevap: Zirve Aktarma

İleti#6)  Miraç CAN » 20 Mar 2020 12:41

Hesap kodu alanında bir veya birkaçı, boş veya sıfır ise de listeye eklensin mi?
Kullanıcı avatarı
Miraç CAN
Siteye Alışmış
 
Kayıt: 26 Arl 2016 19:07
Meslek: Harita/Ölçme
Yaş: 38
İleti: 417
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Amasya\Adana

REKLAM
ETA - Excel Konsolide Raporlama
ETA Excel Personel Entegre Raporu

Cevap: Zirve Aktarma

İleti#7)  Miraç CAN » 20 Mar 2020 13:46

Kod: Tümünü seç
Sub aktar()
Dim Liste As Worksheet, Zirve As Worksheet, Rng As Range
Dim ScUp As Boolean, Calc&, Rw%, Cl%
ScUp = Application.ScreenUpdating: Application.ScreenUpdating = False
Calc = Application.Calculation: Application.Calculation = xlCalculationManual
Set Liste = Sheets("LİSTE"): Set Zirve = Sheets("ZİRVe")
For Each Rng In Liste.Range("A2:A" & Liste.Cells(Rows.Count, 1).End(3).Row)
    Rw = Zirve.Cells(Rows.Count, 1).End(3).Row + 1
    Zirve.Cells(Rw, 1).Resize(4) = Application.Transpose(Liste.[F1:I1])
    For Cl = 0 To 1
        Zirve.Cells(Rw + Cl, 7) = Rng(1, Cl + 6)
        Zirve.Cells(Rw + Cl + 2, 8) = Rng(1, Cl + 8)
    Next Cl
    For Cl = 1 To 5
        Zirve.Cells(Rw, Cl + 1).Resize(4) = Rng(1, Cl)
    Next Cl
Next Rng
Application.Calculation = Calc
Application.ScreenUpdating = ScUp
End Sub
Kullanıcı avatarı
Miraç CAN
Siteye Alışmış
 
Kayıt: 26 Arl 2016 19:07
Meslek: Harita/Ölçme
Yaş: 38
İleti: 417
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Amasya\Adana

Cevap: Zirve Aktarma

İleti#8)  emiroglu07 » 20 Mar 2020 17:30

Üstad öncelikle eline sağlık çok güzel olmuş şkşk
Dediğiniz gibi sıfırlı olan yada işlem görmeyen hesap aktarmasın
Kullanıcı avatarı
emiroglu07
Site Dostu
 
Adı Soyadı:AHMET
Kayıt: 07 Oca 2014 16:36
Konum: İSTANBUL
Meslek: TEKSTİL
Yaş: 33
İleti: 543
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: DİDİM

Cevap: Zirve Aktarma

İleti#9)  Miraç CAN » 20 Mar 2020 17:55

Deneyin:
Kod: Tümünü seç
Sub aktar()
Dim Liste As Worksheet, Zirve As Worksheet, Rng As Range
Dim ScUp As Boolean, Calc&, Rw%, Cl%, Hcr%
ScUp = Application.ScreenUpdating: Application.ScreenUpdating = False
Calc = Application.Calculation: Application.Calculation = xlCalculationManual
Set Liste = Sheets("LİSTE"): Set Zirve = Sheets("ZİRVe")
For Each Rng In Liste.Range("A2:A" & Liste.Cells(Rows.Count, 1).End(3).Row)
    For Hcr = 1 To 4
        Rw = Zirve.Cells(Rows.Count, 1).End(3).Row + 1
        If IsEmpty(Rng(1, Hcr + 5)) Or Rng(1, Hcr + 5) = "" Or Rng(1, Hcr + 5) = 0 Then
        Else
            Zirve.Cells(Rw, 1) = Liste.Cells(1, Hcr + 5).Text
            For Cl = 1 To 5
                Zirve.Cells(Rw, Cl + 1) = Rng(1, Cl)
            Next Cl
            If Hcr < 3 Then Cl = 7 Else Cl = 8
            Zirve.Cells(Rw, Cl) = Rng(1, Hcr + 5)
        End If
    Next Hcr
Next Rng
Application.Calculation = Calc
Application.ScreenUpdating = ScUp
End Sub
Kullanıcı avatarı
Miraç CAN
Siteye Alışmış
 
Kayıt: 26 Arl 2016 19:07
Meslek: Harita/Ölçme
Yaş: 38
İleti: 417
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Amasya\Adana

Cevap: Zirve Aktarma

İleti#10)  emiroglu07 » 21 Mar 2020 08:49

üstad ellerine sağlık tam olmuş çok sağ olun şkşk şkşk
Kullanıcı avatarı
emiroglu07
Site Dostu
 
Adı Soyadı:AHMET
Kayıt: 07 Oca 2014 16:36
Konum: İSTANBUL
Meslek: TEKSTİL
Yaş: 33
İleti: 543
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: DİDİM


Forum Genel Makro Soruları

Online Kullanıcılar

Bu forumu görüntüleyenler: AhrefsBot ve 2 misafir

cron
Bumerang - Yazarkafe