Cari Ekstreyi Düzenleme

[Majak]

Merhaba Üstatlar ;
Ekteki çalışma sayfasında bir değişiklik yapmak istiyorum ancak makro konusunda bilgisizim.İsteğimi dosya içerisinde de belirttim.Şirket isimlerini tüm ekstre satırlarına kopyalamak istiyorum.Yani Şirket 1 in ekstresi kaç satır ise o kadar satır şirket 1 Şirket 2 nin ekstresi kaç satır ise o kadar satır şirket 2 yazsın istiyorum..Emekleriniz için şimdiden teşekkürler...

 

[Ömer BARAN]

Merhaba.

Sayfada E sütunundaki "Devir :" ibaresinden hareketle aşağıdaki kod istediğiniz işlemi yapacaktır.

Dikkat: B sütunundaki mevcut olan veriler silinir.
.

[B]Sub SIRKETLER()[/B]
ilk = [B1].End(xlDown).Row
son = Cells(Rows.Count, "A").End(xlUp).Row
For sat = ilk To son
    If Cells(sat, "E") = "[B][COLOR="Blue"]Devir :[/COLOR][/B]" Then
        sirket = Cells(sat, "B")
        If WorksheetFunction.CountIf(Range(Cells(sat + 1, "E"), Cells(son, "E")), "Devir :") = 0 Then
            sson = son
        Else
            sson = WorksheetFunction.Match("Devir :", Range(Cells(sat + 1, "E"), Cells(son, "E")), 0) - 3 + sat
        End If
        Range(Cells(sat + 1, "B"), Cells(sson, "B")) = sirket
        sat = sson + 2
    End If
Next
MsgBox "İşlem tamamlandı.", vbInformation, "..:: Ömer BARAN ::.."
[B]End Sub[/B]

 

[Majak]

Merhaba

Merhaba Ömer Bey ; Zahmetleriniz için çok teşekkürler.Ancak ben makro konusunda oldukça bilgisiz olduğumdan kodu becerip de deneyemedim.Sizden ricam nasıl denemem gerektiği konusunda yardımcı olur musunuz ?

Merhaba.

Sayfada E sütunundaki "Devir :" ibaresinden hareketle aşağıdaki kod istediğiniz işlemi yapacaktır.

Dikkat: B sütunundaki mevcut olan veriler silinir.
.

[B]Sub SIRKETLER()[/B]
ilk = [B1].End(xlDown).Row
son = Cells(Rows.Count, "A").End(xlUp).Row
For sat = ilk To son
    If Cells(sat, "E") = "[B][COLOR="Blue"]Devir :[/COLOR][/B]" Then
        sirket = Cells(sat, "B")
        If WorksheetFunction.CountIf(Range(Cells(sat + 1, "E"), Cells(son, "E")), "Devir :") = 0 Then
            sson = son
        Else
            sson = WorksheetFunction.Match("Devir :", Range(Cells(sat + 1, "E"), Cells(son, "E")), 0) - 3 + sat
        End If
        Range(Cells(sat + 1, "B"), Cells(sson, "B")) = sirket
        sat = sson + 2
    End If
Next
MsgBox "İşlem tamamlandı.", vbInformation, "..:: Ömer BARAN ::.."
[B]End Sub[/B]

 

[Ömer BARAN]

Tekrar merhaba.

-- Belgeyi açın,
-- Alt taraftan ilgili sayfanın adına fareyle sağ tıklayıp KOD GÖRÜNTÜLEyi seçin,
-- VBA ekranı açılacaktır, açılan VBA ekranında, sağdaki boş alana verdiğim kod'u yapıştırın,
-- İlgili sayfaya bir düğme/metin kutusu/şekil ekleyin,
-- Eklediğiniz düğmeye/metin kutusuna/şekile fareyle sağ tıklayıp MAKRO ATAyı seçin,
-- Açılacak küçük ekranda SIRKETLER 'i seçin (makronun adı) ve işlemi onaylayın.
-- Sayfadaki düğmeye/metin kutusuna/şekile fareyle tıkladığınızda kod çalışarak işlemi tamamlayacaktır.
.

 

[Majak]

Merhaba Ömer Bey ;
Tarif ettiğiniz şekilde yaptım.İşleminiz tamamlandı mesajı veriyor ancak işlem tamamlanmıyor.

Tekrar merhaba.

-- Belgeyi açın,
-- Alt taraftan ilgili sayfanın adına fareyle sağ tıklayıp KOD GÖRÜNTÜLEyi seçin,
-- VBA ekranı açılacaktır, açılan VBA ekranında, sağdaki boş alana verdiğim kod'u yapıştırın,
-- İlgili sayfaya bir düğme/metin kutusu/şekil ekleyin,
-- Eklediğiniz düğmeye/metin kutusuna/şekile fareyle sağ tıklayıp MAKRO ATAyı seçin,
-- Açılacak küçük ekranda SIRKETLER 'i seçin (makronun adı) ve işlemi onaylayın.
-- Sayfadaki düğmeye/metin kutusuna/şekile fareyle tıkladığınızda kod çalışarak işlemi tamamlayacaktır.
.

 

[Ömer BARAN]

Örnek belgeniz, gerçek belge ile aynı yapıda ise sonuç almanız gerekir.
Denemeyi örnek belge üzerinde yapınız.

Örnek belgede sorun çıkmıyor ama gerçek belgenizde sorun yaşıyorsanız;
örnek belgenizi, gerçek belgeyle aynı yapıda olacak şekilde (satır/sütun/sayfa yapısı, veri başlangıç satırı gibi)
yenileyiniz.
.

 

[Majak]

Merhaba Ömer Bey ; Sonunda başarabildim..Sabrınız ve ilginiz için tekrar teşekkürler...

Örnek belgeniz, gerçek belge ile aynı yapıda ise sonuç almanız gerekir.
Denemeyi örnek belge üzerinde yapınız.

Örnek belgede sorun çıkmıyor ama gerçek belgenizde sorun yaşıyorsanız;
örnek belgenizi, gerçek belgeyle aynı yapıda olacak şekilde (satır/sütun/sayfa yapısı, veri başlangıç satırı gibi)
yenileyiniz.
.