• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Tablo Düzenleme

Katılım
23 Mayıs 2014
Mesajlar
92
Excel Vers. ve Dili
2013 türkçe
merhaba;

Ekte tam olarak istediğim,daha doğrusu kendim yapmayı beceremediğim örnek dosya mevcut.

yardımcı olursanız çok sevinirim.

şimdiden teşekkürler
iyi çalışmalar
 

Ekli dosyalar

aşağıdaki kodları bir modüle kopyalayıp dener misiniz?

Kod:
Sub topla()
For i = 2 To WorksheetFunction.Max(2, Cells(Rows.Count, 1).End(3).Row)
yeni = Cells(Rows.Count, 8).End(3).Row + 1
    If WorksheetFunction.CountIf(Range("H2:H" & yeni), Cells(i, 3)) = 0 Then
        Cells(yeni, 8) = Cells(i, 3)
        Cells(yeni, 9) = Cells(i, 1)
        Cells(yeni, 10) = Cells(i, 4)
    Else
        For j = 2 To yeni - 1
        If Cells(j, 8) = Cells(i, 3) Then
        Cells(j, 9) = Cells(j, 9) & "-" & Cells(i, 1)
        Cells(j, 10) = Cells(j, 10) + Cells(i, 4)
        End If
        Next
    End If
Next
End Sub
 
Son düzenleme:
Sn. Yusuf 44 Emeğiniz için Çok teşekkür ederim. yalnız çok ufak bir konu var. hazırlamış olduğunuz liste soldaki bütün kodlara aynı sistemi uyguluyor. sizden ricam h sütununa denk gelen ve sadece o hücrelere yazdığım kodları kontrol etmesidir.birde K stununda, I stununda tarihleri yaptınız gibi B sutunundaki giriş noları yan yana arasına - koyarak yazması.

eğer yardımcı olabilirseniz çok sevinirim.
 
Son düzenleme:
Şöyle dener misiniz?
Kod:
Sub topla1()
For i = 2 To WorksheetFunction.Max(2, Cells(Rows.Count, 1).End(3).Row)
yeni = Cells(Rows.Count, 8).End(3).Row + 1
    If WorksheetFunction.CountIf(Range("H2:H" & yeni), Cells(i, 3)) > 0 Then
        For j = 2 To yeni - 1
        If Cells(j, 8) = Cells(i, 3) Then
            If Cells(j, 9) = "" Then
            Cells(j, 9) = Cells(i, 1)
            Else
            Cells(j, 9) = Cells(j, 9) & "-" & Cells(i, 1)
            End If
        Cells(j, 10) = Cells(j, 10) + Cells(i, 4)
            If Cells(j, 11) = "" Then
            Cells(j, 11) = Cells(i, 2)
            Else
            Cells(j, 11) = Cells(j, 11) & "-" & Cells(i, 2)
            End If
        End If
        Next
    End If
Next
End Sub
 
yusuf bey harika çalışıyor sadece bir yerde hata veriyor tarihle birleştirirken ilk yazdığı tarihin başına -(-) getirmediği için 12.07.2014-01.04.2014 yazması gerekirken 41832-01.04.2014 yazıyor. eğer buda düzelirse tam istediğim gibi.

düzeltme:yusuf bey bir hata yaptığımı yeni fark ettim adet toplamı değil tarih gibi arasında - olarak adetlerinin yazılmasını isterken toplam yazmışım .hata benim kusura bakmayın sizi bayağı ugraştırdım.

şimdiden emeğinize sağlık
 
Son düzenleme:
yeniden merhaba;

yusuf bey tam istediğim macroyu yazdı sadece yukarıda belirttiğim 2 ufak sorun kaldı.yardımlarınızı rica ederim.
 
İlk sorunun çözümü için o hücreyi tarih olarak biçimlendirmeniz gerekir.

İkinci sorun için aşağıdaki kodları deneyin:
Kod:
Sub topla2()
For i = 2 To WorksheetFunction.Max(2, Cells(Rows.Count, 1).End(3).Row)
yeni = Cells(Rows.Count, 8).End(3).Row + 1
    If WorksheetFunction.CountIf(Range("H2:H" & yeni), Cells(i, 3)) > 0 Then
        For j = 2 To yeni - 1
        If Cells(j, 8) = Cells(i, 3) Then
            If Cells(j, 9) = "" Then
            Cells(j, 9) = Cells(i, 1)
            Else
            Cells(j, 9) = Cells(j, 9) & "-" & Cells(i, 1)
            End If
            If Cells(j, 10) = "" Then
            Cells(j, 10) = Cells(i, 4)
            Else
            Cells(j, 10) = Cells(j, 10) & "-" & Cells(i, 4)
            End If
            If Cells(j, 11) = "" Then
            Cells(j, 11) = Cells(i, 2)
            Else
            Cells(j, 11) = Cells(j, 11) & "-" & Cells(i, 2)
            End If
        End If
        Next
    End If
Next
End Sub
 
yusuf bey denedim tarih olarak hücre biçimlendirme işe yaramadı. o tarihinde başına bir (-) koyarak başlarsa sorun çözülür mü?

düzeltme: hücreyi baştan tarih olrak biçimlendirince oldu. haklısınız teşekkürler
 
sorunu kod üstünde oynayarak çözdüm - yerine --- kullanınca sorun çözüldü desteğiniz ve sabrınız için teşekkürler

iyi çalışmalar
 
Son düzenleme:
Geri
Üst