ünvanları say topla

[omeryılmaz]

Değerli Hocalarım C1; C1000 sütununda kayıtlı Değişik Ünvanların (Doktor, Ebe , Hemşire...) sayısal toplamını makro ile nasıl alabiliriz.
Örnek Dosyada ayrıntılı açıklama mevcuttur..
Yardımlarınız için şimdiden Saygılar sunuyorum......

 

[Hacı Bayram ÖZKAN]

ünvanlar

Ünvanları toplamayı makroyla değildi fonksiyonla olsa olurma cevabı ekte

 

[Recep İpek]

Ünvan sıralaması önemli değil ise aşağıdaki kodları deneyiniz.

Sub ÜnvanSay()
Dim a, i, n, sat, veri()
Set s1 = Sheets("Sayfa 1")
'*******************************************
a = s1.Range("c2:c" & s1.[c65536].End(3).Row).Value
ReDim veri(1 To UBound(a, 1), 1 To 2)
'*******************************************
With CreateObject("Scripting.Dictionary")
    .CompareMode = vbTextCompare
    For i = 1 To UBound(a, 1)
           If Not IsEmpty(a(i, 1)) Then
                 If Not .exists(a(i, 1)) Then
                    n = n + 1
                    veri(n, 1) = a(i, 1)
                    .Add a(i, 1), n
                  End If
                    veri(.Item(a(i, 1)), 2) = veri(.Item(a(i, 1)), 2) + 1
                  End If
    Next i
End With
'*******************************************
sat = s1.[g65536].End(3).Row + 1
s1.Range(Cells(2, "g"), Cells(sat, "h")).ClearContents
s1.[g2].Resize(n, 2).Value = veri
''*******************************************
MsgBox "Bitti"
Set s1 = Nothing
End Sub

 

[irfancantr]

Çalışma çok güzel olmuş, bende konu üzerine birşey sormak istiyorum;

1.İşlemde tüm ünvanları g sütununa kendisi sıralıyor.Ben daha önceden sayfa2 b sütununa meslek isimlerini sıraladım.Buradan bularak karşılarına yazabilir mi?

2.Bu ünvanların (c sütunundaki) karşılarında rakamlar olsa (d sütununda) bunlarıda o grup altında toplayabilir mi acaba?

doktor 60
hemşire 20
doktor 10

gibi sıralı olsa sayfa2'nin b sütununda yazılı olan doktor'u bulup karşısına 70 hemşireninde 20 yazabilir mi;

doktor 70
hemşire 20

Yardımlarınızı bekliyorum,şimdiden herkese teşekkürler.

 

[irfancantr]

help me

:yardim: lütfen

 

[irfancantr]

Arkadaşlar üzerinde çalışıyorum ama bir türlü başaramadım.Formüllerle yapıyorum ama kimi zaman el ile düzeltme yaptığım için formül işimi görmüyor yardımlarınızı bekliyorum...

 

[irfancantr]

Günaydın,

Yardım edebilecek kimse yok mu acaba ?

 

[Orion1]

Hele bir örnek dosya yollayın bakalım.
Belki çözen olur.

 

[irfancantr]

sarı renkli alanlar içinde bulunan hücreler için düşünmüştüm sayın EVREN,

Ama bir türlü çözüm üretemedim

 

[irfancantr]

örnekte yolladım fakat cevap alamıyorum (çok ısrar ettim galiba )

 

[Orion1]

Dosyanız Ekte.

Sub Depoyagiren()
Dim i As Long
Sheets("DEPO").Select
Application.ScreenUpdating = False
Range("J9:J65536").Clear
With Sheets("DEPOYA GİREN")
    For i = 9 To Cells(65536, "H").End(xlUp).Row
        If Cells(i, "H").Value <> 0 Or Cells(i, "H").Value <> "" Then
            Cells(i, "J").Value = WorksheetFunction.SumIf(.Range("D9:D65536"), Cells(i, "H").Value, .Range("F9:F65536"))
        End If
    Next i
End With
Application.ScreenUpdating = True
MsgBox "İşlem tamamdır.."
End Sub
Sub Depodancikan()
Dim i As Long
Sheets("DEPO").Select
Application.ScreenUpdating = False
Range("N9:N65536").Clear
With Sheets("DEPODAN ÇIKAN")
    For i = 9 To Cells(65536, "L").End(xlUp).Row
        If Cells(i, "L").Value <> 0 Or Cells(i, "L").Value <> "" Then
            Cells(i, "N").Value = WorksheetFunction.SumIf(.Range("C9:C65536"), Cells(i, "L").Value, .Range("D9:D65536"))
        End If
    Next i
End With
Application.ScreenUpdating = True
MsgBox "İşlem tamamdır.."
End Sub

 

[irfancantr]

Sayın evren çok güzel olmuş emeğinize sağlık , her depo sayfasına geldiğimizde sayfayı yenilese olmaz mı??

Son bir sorum daha başka bir şey sormıyacağım
a1 + b1 = c1
formülünü koda uyarlasak,
fakat bu a1 ve b1 hücreleri a1000 e kadar gidebiliyor,
hangi hücreler doluysa o hücrelerin karşısına toplam alabilir miyim?

 

[Orion1]

Sayın evren çok güzel olmuş emeğinize sağlık ama hergirdiğim ürünü depo sayfasından bulup tek tek hücrelerine çift tıklama yapmam gerekiyor.Biz onun yerine her depo sayfasına geldiğimizde sayfayı yenilese olmaz mı??

Son bir sorum daha başka bir şey sormıyacağım
a1 + b1 = c1
formülünü koda uyarlasak,
fakat bu a1 ve b1 hücreleri a1000 e kadar gidebiliyor,
hangi hücreler doluysa o hücrelerin karşısına toplam alabilir miyim?

Hücre üzerine çift tıklamıyorsunuz.Depo sayfasındaki ilgili butonlara tıklıyorsunuz.

 

[irfancantr]

Kusura bakmayınız, sabah uykum açılmamış koskoca butonları göremedim

Sayın evren hakkınızı ödeyemem çok sağolun; Teşekkürler...

 

[Orion1]

Kusura bakmayınız, sabah uykum açılmamış koskoca butonları göremedim

Sayın evren hakkınızı ödeyemem çok sağolun; Teşekkürler...

Rica ederim.
İyi çalışmalar.

 

[irfancantr]

Son bir sorum daha başka bir şey sormıyacağım
a1 + b1 = c1
formülünü koda uyarlasak,
fakat bu a1 ve b1 hücreleri a1000 e kadar gidebiliyor,
hangi hücreler doluysa o hücrelerin karşısına toplam alabilir miyim?

Sayın hocam sonkez bunada cevap verebilir miyiz acaba?

 

[omerceri]

=eğer(ve(a1<>"";b1<>"");a1+b1;"")

 

[Orion1]

Sayın evren çok güzel olmuş emeğinize sağlık , her depo sayfasına geldiğimizde sayfayı yenilese olmaz mı??

Son bir sorum daha başka bir şey sormıyacağım
a1 + b1 = c1
formülünü koda uyarlasak,
fakat bu a1 ve b1 hücreleri a1000 e kadar gidebiliyor,
hangi hücreler doluysa o hücrelerin karşısına toplam alabilir miyim?

C sütununda a ve b hücrelerini toplar.

Sub topla()
On Error Resume Next
For i = 1 To 1000
    Cells(i, "C").Value = Cells(i, "A").Value + Cells(i, "B").Value
Next i
End Sub

 

[irfancantr]

Allah razı olsun