[Yardım]  makro yardım

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

makro yardım

İleti#1)  ege4564 » 24 Şub 2019 18:59

İyi akşamlar
Ekteki gibi veri girişi yaptığım bir dosyam var.İlk sayfaya eklediğim verileri D sütununda bulunan yerlerine göre ikinci sayfaya kaydetmesini istiyorum. y1 olanlar alt alta, y2 olanlar alt alta gibi.Farklı bir sayfaya da tarih kısmında bugün başlama yapacakları kopyalaması mümkün mü? Teşekürler.
Bu iletideki ekleri görmek için gerekli yetkilere sahip değilsiniz.
Kullanıcı avatarı
ege4564
Yeni Başlamış
 
Kayıt: 24 Şub 2019 01:59
Meslek: Serbest
Yaş: 29
İleti: 10
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Uşak

Cevap: makro yardım

İleti#2)  veyselemre » 24 Şub 2019 20:38

Kod: Tümünü seç
Sub test()

    Set s1 = Sheets("Sayfa1")
    son = s1.Cells(Rows.Count, 1).End(3).Row

    With CreateObject("Scripting.Dictionary")
        For i = 2 To son
            ky = s1.Cells(i, 4).Value
            .Item(ky) = .Item(ky) & "," & i
        Next i

        Sheets.Add after:=Sheets(1)
        kys = .keys
        itms = .items

        For i = 0 To UBound(itms)
            sat = sat + 1
            With Cells(sat, 1).Resize(, 8)
                .MergeCells = True
                .HorizontalAlignment = xlCenter
                .Interior.ColorIndex = 16
                .Value = kys(i)
            End With
            sat = sat + 1
            s1.Rows(1).Copy Cells(sat, 1)
            bol = Split(Mid(itms(i), 2), ",")
            sira = 0
            For Each bl In bol
                sat = sat + 1
                sira = sira + 1
                s1.Cells(bl, 1).Resize(, 8).Copy Cells(sat, 1)
                Cells(sat, 1) = sira
            Next
            sat = sat + 2
        Next i

    End With
    Columns("A:H").EntireColumn.AutoFit
    ActiveSheet.Copy after:=Sheets(2)

    For i = Cells(Rows.Count, 1).End(3).Row To 3 Step -1
        If IsDate(Cells(i, "H").Value) And Cells(i, "H").Value <> Date Then Rows(i).Delete
    Next i

    For i = 3 To Cells(Rows.Count, 1).End(3).Row
        If IsDate(Cells(i, "H").Value) Then
            say = say + 1
            Cells(i, 1) = say
        Else
            say = 0
        End If
    Next i

End Sub
Bu iletideki ekleri görmek için gerekli yetkilere sahip değilsiniz.
Kullanıcı avatarı
veyselemre
Siteye Alışmış
 
Kayıt: 28 Nis 2015 15:53
Meslek: SERBEST
Yaş: 104
İleti: 358
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Ankara / Çubuk

Cevap: makro yardım

İleti#3)  ege4564 » 25 Şub 2019 18:33

Çok teşekkür ederim Veysel Bey.Tarihleri bugün olanları farklı bir sayfa içinde yazabilir misiniz.
Kullanıcı avatarı
ege4564
Yeni Başlamış
 
Kayıt: 24 Şub 2019 01:59
Meslek: Serbest
Yaş: 29
İleti: 10
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Uşak

Cevap: makro yardım

İleti#4)  ege4564 » 12 Mar 2019 12:13

bu konuda bir şeye daha ihtiyacım var ikinci sayfaya kopyaladığımda hep sıralar farklı oluyor bunu isteğim yere kopyalamasını nasıl sağlarım.Yani ilk Y1 sonra Y2 sonra Y3 gibi
Kullanıcı avatarı
ege4564
Yeni Başlamış
 
Kayıt: 24 Şub 2019 01:59
Meslek: Serbest
Yaş: 29
İleti: 10
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Uşak

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

Cevap: makro yardım

İleti#5)  veyselemre » 13 Mar 2019 10:19

Kod: Tümünü seç
Sub test()
    Set s1 = Sheets("Sayfa1")
    son = s1.Cells(Rows.Count, 1).End(3).Row
    s1.Range("A2:H" & son).Sort s1.[d2]
    With CreateObject("Scripting.Dictionary")
        For i = 2 To son
            ky = s1.Cells(i, 4).Value
            .Item(ky) = .Item(ky) & "," & i
        Next i

        Sheets.Add after:=Sheets(1)
        kys = .keys
        itms = .items

        For i = 0 To UBound(itms)
            sat = sat + 1
            With Cells(sat, 1).Resize(, 8)
                .MergeCells = True
                .HorizontalAlignment = xlCenter
                .Interior.ColorIndex = 16
                .Value = kys(i)
            End With
            sat = sat + 1
            s1.Rows(1).Copy Cells(sat, 1)
            bol = Split(Mid(itms(i), 2), ",")
            sira = 0
            For Each bl In bol
                sat = sat + 1
                sira = sira + 1
                s1.Cells(bl, 1).Resize(, 8).Copy Cells(sat, 1)
                Cells(sat, 1) = sira
            Next
            sat = sat + 2
        Next i

    End With
    Columns("A:H").EntireColumn.AutoFit
    ActiveSheet.Copy after:=Sheets(2)

    For i = Cells(Rows.Count, 1).End(3).Row To 3 Step -1
        If IsDate(Cells(i, "H").Value) And Cells(i, "H").Value <> Date Then Rows(i).Delete
    Next i

    For i = 3 To Cells(Rows.Count, 1).End(3).Row
        If IsDate(Cells(i, "H").Value) Then
            say = say + 1
            Cells(i, 1) = say
        Else
            say = 0
        End If
    Next i
    s1.Range("A2:H" & son).Sort s1.[a2]
End Sub
Kullanıcı avatarı
veyselemre
Siteye Alışmış
 
Kayıt: 28 Nis 2015 15:53
Meslek: SERBEST
Yaş: 104
İleti: 358
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Ankara / Çubuk


Forum Genel Makro Soruları

Online Kullanıcılar

Bu forumu görüntüleyenler: Bing[Bot], Google [Bot] ve 1 misafir

Bumerang - Yazarkafe