Dinamik Şekilde Array Kullanımı

Korhan Ayhan

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
42,193
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Bu işlemi bir UserForm üzerinde yapmanız daha uygun görünüyor.

Forumda buna benzer örnekler olacaktı. Linki inceleyiniz.

Veri doğrulama problemi

Merhaba Veri doğrulama ile ilgili içinden çıkamadığım bir durum var ekte gerekli açıklamaları yaptım, yardımcı olabilir misiniz
www.excel.web.tr www.excel.web.tr
 
C

canburak

Altın Üye
Katılım
30 Kasım 2011
Mesajlar
205
Excel Vers. ve Dili
Ofis 2016 Tr 64 Bit , Turkce
Altın Üyelik Bitiş Tarihi
12-09-2025
Tamam Hocam elinize saglik Cok Tesekkur ederim.

Saygilarimla,
 
C

canburak

Altın Üye
Katılım
30 Kasım 2011
Mesajlar
205
Excel Vers. ve Dili
Ofis 2016 Tr 64 Bit , Turkce
Altın Üyelik Bitiş Tarihi
12-09-2025
Merhaba Hocam,
Assagidaki makroya uyarlama yapmaya calistim ama olmadi, yapmak Istedigim A10:A stununda bulunan veri A7 hucresinde ki veriye esit ise A7:R7 Hucrelerini kopyalayip A10:A sutununda ki A7 hucresine esit olan satira gidip yapistirmasi ama birturlu beceremedim.

Saygilarimla,

Sub Degistir()

Dim s1 As Worksheet
Dim Sat As Long

Set s1 = Sheets("Entry")
Sat = s1.Cells(Rows.Count, "A").End(3).Row

If WorksheetFunction.CountIf(s1.Range("A10:A" & s1.Rows.Count), s1.Range("A7")) = 0 Then
s1.Range("A7:R7").Copy
s1.Range("A10" & Sat).PasteSpecial
End If
End Sub
 
Korhan Ayhan

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
42,193
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Farklı sorularınız için lütfen ayrı başlık açınız.
 
C

canburak

Altın Üye
Katılım
30 Kasım 2011
Mesajlar
205
Excel Vers. ve Dili
Ofis 2016 Tr 64 Bit , Turkce
Altın Üyelik Bitiş Tarihi
12-09-2025
Merhabalar Hocam ,
Tekrar rahatsizlik veriyorum veri Dosyasinda ayni veri ye ait toplam tutari getirmede tam istedigimi yapamadim, ilisikte ki dosyada tam olarak sorunumu aciklamaya calistim yardim edebilirmisiniz Lutfen..

Saygilarimla,
 

Ekli dosyalar

veyselemre

veyselemre

Özel Üye
Katılım
9 Mart 2005
Mesajlar
3,642
Excel Vers. ve Dili
Pro Plus 2021
canburak' Alıntı:
Merhabalar Hocam ,
Tekrar rahatsizlik veriyorum veri Dosyasinda ayni veri ye ait toplam tutari getirmede tam istedigimi yapamadim, ilisikte ki dosyada tam olarak sorunumu aciklamaya calistim yardim edebilirmisiniz Lutfen..

Saygilarimla,
Genişletmek için tıkla ...
Mevcut kodunuza sıralama ve bakiye işlemi eklendi.
Kod: 
Option Explicit

Sub LinkCnt()
    Dim S1 As Worksheet, s2 As Worksheet, S3 As Worksheet, Dizi As Object
    Dim son As Long, Veri As Variant, Veri2 As Variant, X As Long, Say As Long, say1 As Long
    Dim Aranan As String, Tarih1 As Date, Tarih2 As Date, Zaman As Double

    Zaman = Timer

    With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
    End With

    Set S1 = Sheets("Rapor")

    Set S3 = Sheets("Anlasma")    ' ana bilgi burdan
    Set Dizi = CreateObject("Scripting.Dictionary")


    S1.Range("A5:I" & S1.Rows.Count).Clear

    son = S3.Cells(S3.Rows.Count, 1).End(3).Row
    Veri = S3.Range("A4:R" & son).Value

    S1.Range("A4") = "TURU"
    S1.Range("B4") = "BAGLANTI NO"
    S1.Range("C4") = "ALICI ADI"
    S1.Range("D4") = "SATICI ADI"
    S1.Range("E4") = "URUN"
    S1.Range("F4") = "SATIS MIKTAR"
    S1.Range("G4") = "BAGLI MIKTAR"
    S1.Range("H4") = "ALIS MIKTARI"
    S1.Range("I4") = " BAKIYE "

    ReDim Liste(1 To son, 1 To 9)

    For X = LBound(Veri) To UBound(Veri)

        If Veri(X, 2) = "Satis" Or Veri(X, 2) = "Bagli" Then

            Aranan = Veri(X, 2) & Veri(X, 4) & Veri(X, 6) & Veri(X, 17)
            If Not Dizi.Exists(Aranan) Then
                Say = Say + 1
                Dizi.Add Aranan, Say
                Liste(Say, 1) = Veri(X, 2)
                Liste(Say, 2) = Veri(X, 17)
                If Veri(X, 2) = "Satis" Then Liste(Say, 3) = Veri(X, 4)
                If Veri(X, 2) = "Bagli" Then Liste(Say, 4) = Veri(X, 4)
                Liste(Say, 5) = Veri(X, 6)
                If Veri(X, 2) = "Satis" Then Liste(Say, 6) = Veri(X, 8)
                If Veri(X, 2) = "Bagli" Then Liste(Say, 7) = Veri(X, 8)

            Else
                If Veri(X, 2) = "Satis" Then Liste(Dizi.Item(Aranan), 3) = Liste(Dizi.Item(Aranan), 3) + Veri(X, 4)
                If Veri(X, 2) = "Bagli" Then Liste(Dizi.Item(Aranan), 4) = Liste(Dizi.Item(Aranan), 4) + Veri(X, 4)
                If Veri(X, 2) = "Satis" Then Liste(Dizi.Item(Aranan), 6) = Liste(Dizi.Item(Aranan), 6) + Veri(X, 8)
                If Veri(X, 2) = "Bagli" Then Liste(Dizi.Item(Aranan), 7) = Liste(Dizi.Item(Aranan), 7) + Veri(X, 8)

            End If
        End If

    Next

    For X = LBound(Veri) To UBound(Veri)
        If Veri(X, 2) = "Alis" Then

            Aranan = Veri(X, 4) & Veri(X, 6)
            If Not Dizi.Exists(Aranan) Then
                Say = Say + 1
                Dizi.Add Aranan, Say
                Liste(Say, 1) = Veri(X, 2)
                Liste(Say, 4) = Veri(X, 4)
                Liste(Say, 5) = Veri(X, 6)
                If Veri(X, 2) = "Alis" Then Liste(Say, 8) = Veri(X, 8)

            Else
                If Veri(X, 2) = "Alis" Then Liste(Dizi.Item(Aranan), 8) = Liste(Dizi.Item(Aranan), 8) + Veri(X, 8)

            End If
        End If
    Next

    If Say > 0 Then
        S1.Range("A5").Resize(Say, 9) = Liste
        S1.Range("C5").Resize(Say, 7).Style = "Comma"
        S1.Range("C3").Resize(1, 7).Style = "Comma"
        S1.Columns.AutoFit
    End If

'***************** eklenen **************
    S1.Range("A5:I" & Say + 5).Sort S1.[B5], xlAscending, S1.[A5], , xlDescending
    say1 =Empty
    Aranan = ""

    For X = 5 To Say + 4
        If S1.Cells(X, 2).Value <> "" Then
            If S1.Cells(X, 2).Value <> Aranan Then
                say1 = Empty
                Aranan = S1.Cells(X, 2).Value
            End If
            say1 = say1 + S1.Cells(X, 6).Value - S1.Cells(X, 7).Value
            If say1 <> Empty Then S1.Cells(X, 9).Value = say1
        End If
    Next X
'****************************************

    Set S1 = Nothing
    Set s2 = Nothing
    Set S3 = Nothing
    Set Dizi = Nothing

    With Application
        .ScreenUpdating = True
        .Calculation = xlCalculationAutomatic
    End With


End Sub
 
Son düzenleme:
C

canburak

Altın Üye
Katılım
30 Kasım 2011
Mesajlar
205
Excel Vers. ve Dili
Ofis 2016 Tr 64 Bit , Turkce
Altın Üyelik Bitiş Tarihi
12-09-2025
Merhaba Hocam, Tesekkurler , Ama Rapor sayfasindaki A sutunundaki veri "Alis" ise Rapordaki"G: sutununa toplami ,Anlasma sayfasindaki " B" sutunun da ki veri "Bagli" yaziyorsa ;Bu islemli yapmasi gerekiyor Anlasma sayfasindaki H sutununun Toplamini , Anlasma Sayfasindaki D sutunu esit ise Rapor daki D sutununa ve Anlasma Sayfasindaki F sutunu esit ise Rapordaki E sutununa ..

Saygilarimla,
 
C

canburak

Altın Üye
Katılım
30 Kasım 2011
Mesajlar
205
Excel Vers. ve Dili
Ofis 2016 Tr 64 Bit , Turkce
Altın Üyelik Bitiş Tarihi
12-09-2025
Hocam kisaca D ve F Sutunlarindaki bilgiler Ayni Sadece B sutunu farkli Kisaca Rapor sayfasina A sutundaki Alislarin karsinidaki G Sutununa Anlasmadaki B sutununda "Bagli" gecenlerin Toplam miktari getirmek istiyorum
(B sutunu Alis' D ve F Sutununa esit ise B sutunundaki Bagli'nin Toplam'ini Rapordaki G sutununa getirmesi lazim?)

228602
 
C

canburak

Altın Üye
Katılım
30 Kasım 2011
Mesajlar
205
Excel Vers. ve Dili
Ofis 2016 Tr 64 Bit , Turkce
Altın Üyelik Bitiş Tarihi
12-09-2025
veyselemre' Alıntı:
Mevcut kodunuza sıralama ve bakiye işlemi eklendi.
Kod: 
Option Explicit

Sub LinkCnt()
    Dim S1 As Worksheet, s2 As Worksheet, S3 As Worksheet, Dizi As Object
    Dim son As Long, Veri As Variant, Veri2 As Variant, X As Long, Say As Long, say1 As Long
    Dim Aranan As String, Tarih1 As Date, Tarih2 As Date, Zaman As Double

    Zaman = Timer

    With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
    End With

    Set S1 = Sheets("Rapor")

    Set S3 = Sheets("Anlasma")    ' ana bilgi burdan
    Set Dizi = CreateObject("Scripting.Dictionary")


    S1.Range("A5:I" & S1.Rows.Count).Clear

    son = S3.Cells(S3.Rows.Count, 1).End(3).Row
    Veri = S3.Range("A4:R" & son).Value

    S1.Range("A4") = "TURU"
    S1.Range("B4") = "BAGLANTI NO"
    S1.Range("C4") = "ALICI ADI"
    S1.Range("D4") = "SATICI ADI"
    S1.Range("E4") = "URUN"
    S1.Range("F4") = "SATIS MIKTAR"
    S1.Range("G4") = "BAGLI MIKTAR"
    S1.Range("H4") = "ALIS MIKTARI"
    S1.Range("I4") = " BAKIYE "

    ReDim Liste(1 To son, 1 To 9)

    For X = LBound(Veri) To UBound(Veri)

        If Veri(X, 2) = "Satis" Or Veri(X, 2) = "Bagli" Then

            Aranan = Veri(X, 2) & Veri(X, 4) & Veri(X, 6) & Veri(X, 17)
            If Not Dizi.Exists(Aranan) Then
                Say = Say + 1
                Dizi.Add Aranan, Say
                Liste(Say, 1) = Veri(X, 2)
                Liste(Say, 2) = Veri(X, 17)
                If Veri(X, 2) = "Satis" Then Liste(Say, 3) = Veri(X, 4)
                If Veri(X, 2) = "Bagli" Then Liste(Say, 4) = Veri(X, 4)
                Liste(Say, 5) = Veri(X, 6)
                If Veri(X, 2) = "Satis" Then Liste(Say, 6) = Veri(X, 8)
                If Veri(X, 2) = "Bagli" Then Liste(Say, 7) = Veri(X, 8)

            Else
                If Veri(X, 2) = "Satis" Then Liste(Dizi.Item(Aranan), 3) = Liste(Dizi.Item(Aranan), 3) + Veri(X, 4)
                If Veri(X, 2) = "Bagli" Then Liste(Dizi.Item(Aranan), 4) = Liste(Dizi.Item(Aranan), 4) + Veri(X, 4)
                If Veri(X, 2) = "Satis" Then Liste(Dizi.Item(Aranan), 6) = Liste(Dizi.Item(Aranan), 6) + Veri(X, 8)
                If Veri(X, 2) = "Bagli" Then Liste(Dizi.Item(Aranan), 7) = Liste(Dizi.Item(Aranan), 7) + Veri(X, 8)

            End If
        End If

    Next

    For X = LBound(Veri) To UBound(Veri)
        If Veri(X, 2) = "Alis" Then

            Aranan = Veri(X, 4) & Veri(X, 6)
            If Not Dizi.Exists(Aranan) Then
                Say = Say + 1
                Dizi.Add Aranan, Say
                Liste(Say, 1) = Veri(X, 2)
                Liste(Say, 4) = Veri(X, 4)
                Liste(Say, 5) = Veri(X, 6)
                If Veri(X, 2) = "Alis" Then Liste(Say, 8) = Veri(X, 8)

            Else
                If Veri(X, 2) = "Alis" Then Liste(Dizi.Item(Aranan), 8) = Liste(Dizi.Item(Aranan), 8) + Veri(X, 8)

            End If
        End If
    Next

    If Say > 0 Then
        S1.Range("A5").Resize(Say, 9) = Liste
        S1.Range("C5").Resize(Say, 7).Style = "Comma"
        S1.Range("C3").Resize(1, 7).Style = "Comma"
        S1.Columns.AutoFit
    End If

'***************** eklenen **************
    S1.Range("A5:I" & Say + 5).Sort S1.[B5], xlAscending, S1.[A5], , xlDescending
    say1 =Empty
    Aranan = ""

    For X = 5 To Say + 4
        If S1.Cells(X, 2).Value <> "" Then
            If S1.Cells(X, 2).Value <> Aranan Then
                say1 = Empty
                Aranan = S1.Cells(X, 2).Value
            End If
            say1 = say1 + S1.Cells(X, 6).Value - S1.Cells(X, 7).Value
            If say1 <> Empty Then S1.Cells(X, 9).Value = say1
        End If
    Next X
'****************************************

    Set S1 = Nothing
    Set s2 = Nothing
    Set S3 = Nothing
    Set Dizi = Nothing

    With Application
        .ScreenUpdating = True
        .Calculation = xlCalculationAutomatic
    End With


End Sub
Genişletmek için tıkla ...
Bu arada Hocam elinize saglik bakiye islemi ve siralama guzel calisiyor, tek 47-48 numarali mesajda yazdigim sorun kaldi.

Saygilarimla,
 
C

canburak

Altın Üye
Katılım
30 Kasım 2011
Mesajlar
205
Excel Vers. ve Dili
Ofis 2016 Tr 64 Bit , Turkce
Altın Üyelik Bitiş Tarihi
12-09-2025
Merhabalar Hocam,
Assagida belirttigim formule kucuk yada bos ise formulunu sanirim ekleyemedim internettene arastirim ama birturlu olmadi yardimci olabilirmisiniz lutfen?

.Formula = "=SUMIFS('Mal'!F:F,'Mal'!B:B,""Satis"",'Mal'!N:N,B5)"

Yapmak istedigim bu formule ilave kosul eklemek ,'Mal'!T:T, sutunu Bos ise yada 1 den kucuk ise seklinde

Cok Tesekkurler
 
Cevap yazmak için giriş yap yada kayıt ol.
Üst