Veri almak

[suleyman057]

slm saygıdeğer üstadlar, sizlerin yardımınıza ihtiyacım var benden yardımlarınızı esirgemezseniz çok sevinirim, yardımınızı istemiş olduğuım konuyu kısaca özetleyim excellin bir sayfasında verilerim var ben diğer bir sayfaya özet gibi bişey çekmek istiyorum örnek olarak hazırlamış olduğum dosya ektedir yardımlarınız için şimdiden tşk ederim saygılarımla...

 

[Orion1]

excel 2003 formatında eklerseniz dağa çabuk cevap alabilirsiniz.

 

[suleyman057]

üstad dediğiniz gibi ekledim şimdiden tşk ederim

 

[Recep İpek]

Peki diğer firmaları ayrı sayfalarda mı istiyorsunuz?Yoksa yan yana mı olacak?

 

[suleyman057]

2. sayfada bulunan özette 120-159-320-340 gibi hesapları düşeyara ile çağırdıoğm firmalar gelecek yani hesap adı değiştiğinde 120-159-320-340 hs larda veri sayfasındaki duruma göre değişmesi lazım kısaca ben düşeyara ile hangi firmayı çağrırsam o firmanın bilgileri gelmesi lazım, ben yapması kolay olsun diye 3 firma yazdım bu normalde 200-300 firma arası değişiyor ben o bilgiler sayesinde tek bir firmanın başka hesap kodlarındaki rakamlarını rahatlıkla görmüş olacağım saygılarımla...

 

[Orion1]

Bunun için makro yazdım.Bekleyin fonksiyonla yapan arkadaş çıkarsa onu koullanırsınız çıkmazsa bunu.
Makroları etkinleştirmeniz(güvenlik düzeyini en düşüğe ayarlamanız ) lazım.
Dosya ektedir.

Sub hesap()
'Hazırlayan evrengizlen@hotmail.com
Dim z As Object, hcr As Range, sat As Long, son As Long
Dim deg As String, sayi As String
On Error Resume Next
Sheets("ÖZET").Select
Application.ScreenUpdating = False
Range("A4:B65536").ClearContents
Set z = CreateObject("scripting.dictionary")
deg = UCase(Replace(Replace(Range("B2").Value, "ı", "I"), "i", "İ"))
With Sheets("VERİ ALANI")
    son = .Cells(65536, "C").End(xlUp).Row
    For Each hcr In .Range("C2:C" & son)
        If UCase(Replace(Replace(hcr.Value, "ı", "I"), "i", "İ")) = deg Then
            sayi = Int(CDbl(Replace(hcr.Offset(0, -1).Value, ".", ",")))
            If Not z.exists(sayi) Then
                z.Add sayi, hcr.Offset(0, 1).Value
                Else
                z.Item(sayi) = z.Item(sayi) + hcr.Offset(0, 1).Value
            End If
        End If
    Next
End With
Range("A4").Resize(z.Count, 2) = Application.Transpose(Array(z.keys, z.items))
Application.ScreenUpdating = True
    
End Sub

[CODE]Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [B1]) Is Nothing Then Exit Sub

Call hesap
End Sub

[/CODE]