• DİKKAT

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

aynı verileri tek satırda toplama

  • Konbuyu başlatan Konbuyu başlatan alprr
  • Başlangıç tarihi Başlangıç tarihi
A

alprr

Katılım
7 Eylül 2008
Mesajlar
28
Excel Vers. ve Dili
2007-tr
5 sütunlu bir veritabanında 4 sütundakilerin aynı olması durumunda 5. sütundakileri toplamasını nasıl yaparım?
EKTEKİ dosyada ayrıntıları anlattım.
teşekkür ederim.
 

Ekli dosyalar

Son düzenleme:
2007 dosyalarını sıkıştırarak ekleyiniz.
xlsx uzantıları eklenemiyor.
Ya da dosyayı 2003 olarak kaydedip öyle ekleyiniz.
 
sorunuz tam net değil biraz daha acıklayabilrmisiniz
saymak için eğersay fonksiyonun kullanacağım ama verilerin yetersiz
 
sanırım dosyayı yanlış eklemişim.
tekrar ekte bulabilirisiniz.

teşekkür ederim.
 

Ekli dosyalar

Dosyanız ektedir.:cool:
Kod: 
Option Base 1
Sub teke_indir()
Dim z, sat As Long, a(), n As Long, myarr(), deg As String, i As Long
Set z = CreateObject("Scripting.Dictionary")
sat = Cells(65536, "B").End(xlUp).Row
ReDim myarr(1 To 9, 1 To sat)
a = Range("B16:I" & sat).Value
For i = 1 To UBound(a, 1)
    deg = a(i, 1) & a(i, 2) & a(i, 6)
    If Not z.exists(deg) Then
        n = n + 1
        z.Add deg, n
        myarr(1, n) = n
    End If
        myarr(2, z.Item(deg)) = a(i, 1)
        myarr(3, z.Item(deg)) = a(i, 2)
        myarr(4, z.Item(deg)) = a(i, 3)
        myarr(5, z.Item(deg)) = myarr(5, z.Item(deg)) + a(i, 4)
        myarr(6, z.Item(deg)) = a(i, 5)
        myarr(7, z.Item(deg)) = a(i, 6)
        myarr(8, z.Item(deg)) = a(i, 7)
        myarr(9, z.Item(deg)) = a(i, 8)
Next
Application.ScreenUpdating = False
Range("A16:I65536").ClearContents
Range("A16").Resize(n, 9) = Application.Transpose(myarr)
Application.ScreenUpdating = True
MsgBox "Teke indirme yapıldı." & vbLf & _
"evrengizlen@hotmail.com", vbOKCancel + vbInformation, "E V R E N"
       
End Sub
 

Ekli dosyalar

teşekkür ederim.
emeğinize sağlık.
çok güzel çalışıyor.
 
Yeni bir çalışma daha var. Bu biraz zor gibi sanırım.
Ekteki dosyada detayları anlattım.

Yardımcı olursanız sevinirim.

teşekkür ederim.
 

Ekli dosyalar

alprr' Alıntı:
Yeni bir çalışma daha var. Bu biraz zor gibi sanırım.
Ekteki dosyada detayları anlattım.

Yardımcı olursanız sevinirim.

teşekkür ederim.
Genişletmek için tıkla ...
Zor diye bir şey yoktur.
Esas olan soruyu anlamak zor benim için.Yoksa soruyu çözmek problem değil.
Kodlar standart tır.Ona uygun kodu yazarım olur biter.Ama dediğim gibi önemli olan soruyu anlamak.Mesela Sizin son yoladığınız dosyada yaptığınız açıklamdaki gibi.
Hiç bir şey anlamadım.:cool:
 
Dosyada bir hücre açıklaması ekledim.
Sizi anlıyorum bende bu tarz işleri az çok yapıyorum ama vb'yi çok beceremiyorum.
Iyi bir şekilde size aktarmam lazım.
Biraz bişeyler denedim.
Ilginiz için teşekkür ederim.
 

Ekli dosyalar

alprr' Alıntı:
Dosyada bir hücre açıklaması ekledim.
Sizi anlıyorum bende bu tarz işleri az çok yapıyorum ama vb'yi çok beceremiyorum.
Iyi bir şekilde size aktarmam lazım.
Biraz bişeyler denedim.
Ilginiz için teşekkür ederim.
Genişletmek için tıkla ...
Siz ne istyorsunuz 1.koli,2.koli.....n koli sütunlarına bazı değerlerinmi yazılmasını istiyorsunuz.Bunları kod ile buluptamı yazacağız.Mesela 12nci satırda 30000 değerine nasıl ulaştınız.Bu değeri nereden aldınız.Alırken kriteriniz ne idi?:cool:
 
1. koli 2. koli .. sütunlarının da sayı olan hücrelerin kesiştiği satırdaki bilgileri baskı alanındaki şekilde yazmasını istiyorum.
baskı alanına bir veri girilmeyecek. orası en son hali olacak. koli sütunlarının altına veri girilecek.
 
Son haliyle birazdaha açık birşekilde anlattım.

Teşekkür ederim.
 

Ekli dosyalar

ekte dosyayı istediklerimi içericek şekilde bulabilirsiniz.
yardımcı olursanız sevinirim.

teşekkürler
alper
 

Ekli dosyalar

konu ile alakalı ilk sorunuzda 3 kritere göre 4.alanların toplamı sonucu var, orada dördüncü değerlerin toplamı değilde en küçük olanı nasıl buluruz?
 
bu örnek için b sütununa eklenicekleri alfabetik sırada nasıl dizebilirim acaba?

teşekkür ederim.


Evren Gizlen' Alıntı:
Dosyanız ektedir.:cool:
Kod: 
Option Base 1
Sub teke_indir()
Dim z, sat As Long, a(), n As Long, myarr(), deg As String, i As Long
Set z = CreateObject("Scripting.Dictionary")
sat = Cells(65536, "B").End(xlUp).Row
ReDim myarr(1 To 9, 1 To sat)
a = Range("B16:I" & sat).Value
For i = 1 To UBound(a, 1)
    deg = a(i, 1) & a(i, 2) & a(i, 6)
    If Not z.exists(deg) Then
        n = n + 1
        z.Add deg, n
        myarr(1, n) = n
    End If
        myarr(2, z.Item(deg)) = a(i, 1)
        myarr(3, z.Item(deg)) = a(i, 2)
        myarr(4, z.Item(deg)) = a(i, 3)
        myarr(5, z.Item(deg)) = myarr(5, z.Item(deg)) + a(i, 4)
        myarr(6, z.Item(deg)) = a(i, 5)
        myarr(7, z.Item(deg)) = a(i, 6)
        myarr(8, z.Item(deg)) = a(i, 7)
        myarr(9, z.Item(deg)) = a(i, 8)
Next
Application.ScreenUpdating = False
Range("A16:I65536").ClearContents
Range("A16").Resize(n, 9) = Application.Transpose(myarr)
Application.ScreenUpdating = True
MsgBox "Teke indirme yapıldı." & vbLf & _
"evrengizlen@hotmail.com", vbOKCancel + vbInformation, "E V R E N"
       
End Sub
Genişletmek için tıkla ...
 
Sayfaya attıktan sonra süzebilirsiniz.:cool:
 
makro ile nasıl yaparız peki?

ben makro kaydetten birşeyler denedim ama son satırdaki
Range("A16").Resize(n, 9) = Application.Transpose(myarr)
kodu ile aktarım yaparken alfabetik olarak aktarma yapabilirmiyiz?

ben macro kayıt ile şu kodları yapıyorum. ama daha doğru bir şekli varmı:
Range("b15:i15").Select
Selection.AutoFilter
ActiveWorkbook.Worksheets("İHR TR FTR").AutoFilter.Sort.SortFields.Clear
ActiveWorkbook.Worksheets("İHR TR FTR").AutoFilter.Sort.SortFields.Add Key:= _
Range("B15"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("İHR TR FTR").AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("b15:i15").Select
Selection.AutoFilter

teşekkür ederim.

birde 15. mesajımdaki konuma yardımcı olabilirmisiniz rica etsem.
 
alprr' Alıntı:
makro ile nasıl yaparız peki?

ben makro kaydetten birşeyler denedim ama son satırdaki
Range("A16").Resize(n, 9) = Application.Transpose(myarr)
kodu ile aktarım yaparken alfabetik olarak aktarma yapabilirmiyiz?

ben macro kayıt ile şu kodları yapıyorum. ama daha doğru bir şekli varmı:
Range("b15:i15").Select
Selection.AutoFilter
ActiveWorkbook.Worksheets("İHR TR FTR").AutoFilter.Sort.SortFields.Clear
ActiveWorkbook.Worksheets("İHR TR FTR").AutoFilter.Sort.SortFields.Add Key:= _
Range("B15"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("İHR TR FTR").AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("b15:i15").Select
Selection.AutoFilter

teşekkür ederim.

birde 15. mesajımdaki konuma yardımcı olabilirmisiniz rica etsem.
Genişletmek için tıkla ...

Makro kaydet yöntemini kulanarak kodları elde edebilirsiniz.:cool:
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst