Soru Kodlamada Aralık tanımlama

dengeceteris · 30 Haziran 2020

Sevgili forum uzmanı arkadaşlar hepinize iyi günler dilerim. Bir konuda yardımınıza ihtiyacım var şimdiden hepinize tşk ederim. Bu siteden öğrendiğm ve çok sıklıkla kullandığım bir kodlama var. Aşağıda bir örneğini paylaştım. Burada ihtiyacım olan ise a1 =..... a2 =..... vb tanımlamalarda adres olarak A sütunu veya AA sütunu gibi bütün sütunları seçiyoruz. Şu imkan varmıdır varsa nasıl yapılır. Mesela benim a1 adresinde 1 den başlayıp 3000' e kadar kodlarım mevcut ve adres olarak bütün A sütunu değil de kod numarası 300 ile başlayıp 500 kadar gidenler a2 de kod aralığı 2000 ile 3000 arası olanları al gibi bir imkanım varmıdır.

Sub ANALİZ4()
Dim i As Long, sons As Long, sond As Long, z As Date
Dim S1 As Worksheet, S2 As Worksheet, Wf As WorksheetFunction
Dim a1 As String, a2 As String, a3 As String, a4 As String, a5 As String, b1 As String
z = Timer
With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
.EnableEvents = False
End With
Set S1 = Sheets("ANALİZ")
Set S2 = Sheets("VERİKAYNAGİ")
Set Wf = WorksheetFunction
Ss.Select
son1 = S1.Cells(Rows.Count, 1).End(xlUp).Row
son2 = S2.Cells(Rows.Count, 1).End(xlUp).Row

Ss.Range("AC3:AD" & Rows.Count).ClearContents

a1 = S2.Range("A3:A" & son2).Address(external:=True)
a2 = S2.Range("AG3:AG" & son2).Address(external:=True)
a3 = S2.Range("AH3:AH" & son2).Address(external:=True)
a4 = S2.Range("AI3:AI" & son2).Address(external:=True)
......

......

Korhan Ayhan · 1 Temmuz 2020

Örnek dosya üzerinde yapmak istediğinizi açıklarsanız daha net cevaplar alabilirsiniz.

dengeceteris · 1 Temmuz 2020

Hocam yapmak istediğimin küçük bir parçsını aldım buraya ANALİZ sayfamda K ve L sütunlarına VERİ KAYNAĞI sayfasından bazı sonuçları getirmek istiyorum. Bunu da mesela 1 ve 2 olanlar şuraya gelsin 60 ve70 olanlar buraya gelsin gibi tek tek yazmaktansa mesela VERİ KAYNAĞI sayfasında ki 1 ve 2 nin anlamı adresi budur 60 şudur gibi bir şey mi yazmam lazım.

veyselemre · 1 Temmuz 2020

Sorunuzdan bir şey anlamadım ama, ikinci sayfadaki tabloyu yandaki verilere göre satır toplamlarını veri sayfanızdan almak istediğinizi düşünerek kodu yazdım.
VERİ KAYNAĞI B sütunu 1 olanlardan 3 olanların farkı
açıklamanızı A sütunda 1 olanlardan 3 olanların çıkarılması şeklinde yorumladım.
Çıkarılacak kodların başına - ekledim.
Örneği inceleyin.

Kod:

Sub test()
    Set sV = Sheets("VERİ KAYNAĞI")
    Set sA = Sheets("ANALİZ")
    sA.Range("Q2:R" & Rows.Count).ClearContents
    liste = sV.Range("A2:E" & sV.Cells(Rows.Count, 1).End(3).Row).Value
    Dim w(1 To 2)

    With CreateObject("Scripting.Dictionary")
        For i = LBound(liste) To UBound(liste)
            For ii = 1 To 3
                al = liste(i, ii)
                If .exists(al) Then
                    Z = .Item(al)
                    Z(1) = Z(1) + liste(i, 4)
                    Z(2) = Z(2) + liste(i, 5)
                    .Item(al) = Z
                Else
                    Z = w
                    Z(1) = liste(i, 4)
                    Z(2) = liste(i, 5)
                    .Item(al) = Z
                End If
            Next ii
        Next i
        sA.Select
        son = sA.Cells(Rows.Count, 1).End(3).Row
        For i = 2 To son
            For ii = 1 To 15
                If sA.Cells(i, ii) <> "" And IsNumeric(sA.Cells(i, ii)) Then
                    al = sA.Cells(i, ii)
                    If al < 0 Then
                        cikar = True
                        al = -1 * al
                    Else
                        cikar = False
                    End If
                    If .exists(al) Then
                        Z = .Item(al)
                        Set q = sA.Cells(i, "Q")
                        Set r = sA.Cells(i, "R")
                        q.Value = q.Value + IIf(cikar, -1 * Z(1), Z(1))
                        r.Value = r.Value + IIf(cikar, -1 * Z(2), Z(2))
                    End If
                End If
            Next ii
        Next i
    End With

End Sub

dengeceteris · 1 Temmuz 2020

Sayın VeyselEmre sorundan bir şey anlamadım demişsin ama bence gayet iyi anlamışsın ! olayı ben anlatamamışım. Tam istediğim bu sadece bir sorunum daha var. Örnekten anladığım bir yerde çıkarma işlemi yapacaksam (-) eksi işareti koymam gerekecek. Peki örnekte ki 10. satırda 1 ile 3 ün farkı değil de mesela (1+3) / (4+5) yapacaksam nasıl olmalı tek eksikliğim bu?

veyselemre · 1 Temmuz 2020

1+3 ü bir satırda hesaplatıp, ikinci bir satırda 4+5 i hesaplatıp ikinci bir tablo oluşturup orada bölme işlemini yapacaksınız, en kolayı bu, araya geçiş tablosu oluşturacaksınız. Dökümü son tablodan alacaksınız. Yoksa bütün hesaplama alternatiflerine göre yeniden kod yazmak gerekir uzun iş.

veyselemre · 1 Temmuz 2020

Uğraştırdı ama böyle kullanabilirsiniz. Hesaplamaları sadece A sütununa yazın.

Kod:

Sub test2()
    Set sV = Sheets("VERİ KAYNAĞI")
    Set sA = Sheets("ANALİZ")
    sA.Range("Q2:R" & Rows.Count).ClearContents
    liste = sV.Range("A2:E" & sV.Cells(Rows.Count, 1).End(3).Row).Value
    Dim w(1 To 2)

    With CreateObject("Scripting.Dictionary")
        For i = LBound(liste) To UBound(liste)
            For ii = 1 To 3
                al = liste(i, ii)
                If .exists(al) Then
                    Z = .Item(al)
                    Z(1) = Z(1) + liste(i, 4)
                    Z(2) = Z(2) + liste(i, 5)
                    .Item(al) = Z
                Else
                    Z = w
                    Z(1) = liste(i, 4)
                    Z(2) = liste(i, 5)
                    .Item(al) = Z
                End If
            Next ii
        Next i
        sA.Select
        son = sA.Cells(Rows.Count, 1).End(3).Row
        For i = 2 To son
            Dim col As New Collection
            al = sA.Cells(i, 1)
            If al <> "" Then
                a = "="
                onc_n = False
                For ii = 1 To Len(al)
                    b = Mid(al, ii, 1)
                    If IsNumeric(b) Then nm = True Else nm = False
                    If nm <> onc_n Then
                        col.Add a
                        a = b
                        onc_n = nm
                    Else
                        a = a & b
                        onc_n = nm
                    End If
                Next ii
                col.Add a

                f1 = ""
                f2 = ""
                If col.Count > 0 Then
                    For iii = 1 To col.Count
                        If IsNumeric(col(1)) Then
                            Z = .Item(Val(col(1)))
                            f1 = f1 & Z(1)
                            f2 = f2 & Z(2)
                        Else
                            f1 = f1 & col(1)
                            f2 = f2 & col(1)
                        End If
                        col.Remove 1
                    Next iii
                End If
                sA.Cells(i, "Q") = Evaluate(f1)
                sA.Cells(i, "R") = Evaluate(f2)
            End If
        Next i
    End With

End Sub

dengeceteris · 2 Temmuz 2020

Sayın Veyselemre kodu vba kısmına yapıştırıp çalıştırınca aşağıdaki bölüm hata veriyor. Sizin resimde düzgün görünüyor ama.

If IsNumeric(col(1)) Then
Z = .Item(Val(col(1)))
f1 = f1 & Z(1) (burası sarıya dönüyor)
f2 = f2 & Z(2)
Else

dengeceteris · 2 Temmuz 2020

Üstad ben dosyayı buraya bıraktım. Muhtemelen bir yerde hata yapıyorumdur.

veyselemre · 2 Temmuz 2020

Hesap planında 365 var mı ki?

dengeceteris · 2 Temmuz 2020

Hocam zannedersem A50 hücresinde ki 365 den bahsediyorsunuz. Elbette hesap planın da 100 den 1000'e kadar hepsini kullanabilirsiniz. Zaten orda yazılan da yıl sayısı çarpımıydı. Denemek için ekledim de onu çıkarsam da çalışmadı. Sadece siz çalıştığına dair fotoğraflayıp gönderdiğinize göre ben bir yerde yanlış bir işlem mi yapıyorum diye şüphe ediyorum.

veyselemre · 2 Temmuz 2020

Evet o 365 den bahsediyorum. Veri kaynağı sayfasında 365 li hesap yok dolayısıyla hata verecektir. Kaldı ki siz 365 yazarak 365 koduna ait toplamlarını değil somut olarak 365 le çarpmayı kastediyorsunuz galiba, kodun bunu bilmesine imkan yoktu.

Kodu düzenledim. Manuel işlem yapmak için rakamın sonuna nokta ekleyin veya rakamı başına sıfır ekleyerek 3 haneliden fazla hale getirin.

(32)/(60+61)*365.

(32)/(60+61)*0365

Kod:

Sub test2()
    Set sV = Sheets("VERİ KAYNAĞI")
    Set sA = Sheets("ANALİZ")
    sA.Range("D2:E" & Rows.Count).ClearContents
    liste = sV.Range("A2:E" & sV.Cells(Rows.Count, 1).End(3).Row).Value
    Dim w(1 To 2)

    With CreateObject("Scripting.Dictionary")
        For i = LBound(liste) To UBound(liste)
            For ii = 1 To 3
                al = liste(i, ii)
                If .exists(al) Then
                    Z = .Item(al)
                    Z(1) = Z(1) + liste(i, 4)
                    Z(2) = Z(2) + liste(i, 5)
                    .Item(al) = Z
                Else
                    Z = w
                    Z(1) = liste(i, 4)
                    Z(2) = liste(i, 5)
                    .Item(al) = Z
                End If
            Next ii
        Next i
        sA.Select
        son = sA.Cells(Rows.Count, 1).End(3).Row
        For i = 2 To son
            Dim col As New Collection
            al = sA.Cells(i, 1)
            If al <> "" Then
                a = "="
                onc_n = False
                For ii = 1 To Len(al)
                    b = Mid(al, ii, 1)
                    If IsNumeric(b) Or b = "." Then nm = True Else nm = False
                    If nm <> onc_n Then
                        col.Add a
                        a = b
                        onc_n = nm
                    Else
                        a = a & b
                        onc_n = nm
                    End If
                Next ii
                col.Add a

                f1 = ""
                f2 = ""
                If col.Count > 0 Then
                    For iii = 1 To col.Count
                        If IsNumeric(col(1)) And Len(col(1)) < 4 And InStr(col(1), ".") = 0 Then
                                Z = .Item(Val(col(1)))
                                f1 = f1 & Z(1)
                                f2 = f2 & Z(2)
                        Else
                            f1 = f1 & col(1)
                            f2 = f2 & col(1)
                        End If
                        col.Remove 1
                    Next iii
                End If
                sA.Cells(i, "D") = Evaluate(f1)
                sA.Cells(i, "E") = Evaluate(f2)
            End If
        Next i
    End With

End Sub

dengeceteris · 2 Temmuz 2020

Üstad sizi yoruyorum kusura bakmayın. Ama ben sizin kodları aynen yapıştırdım. her yerde #DEĞER! gösteriyor. yani 0365 den bağımsız olarak çalışmıyor. Ama (30+40) yazdığım her yer çalışyor.

veyselemre · 2 Temmuz 2020

12nolu mesaja örnek dosyanızı ekledim, ordan deneyin.

dengeceteris · 2 Temmuz 2020

Hocam çok çok tşk ederim. Bu bana özel yada benim bir firmaya has kullanacağım tablo değil. Özellikle bankaların kredi çalışması için denetim firmalarından istediği standart bir çalışma onun için umarım forum üyeleri de sadece kodlama A sütununda gerekli değişiklikleri yaparak kullanabilirler. Çok çok sağolun..

dengeceteris · 2 Temmuz 2020

Hocam bir önceki mesajım da tamam dedim ama anlamıyorum dosyayı indirdiğim zaman her şey yerli yerinde ama butona bastığım anda bir anda her şeyi #DEĞER! gösteriyor maalesef. Dosyayı zaten siz hazırlamışsınız ama aynı dosyayı indiriyorum bende çalışmıyor. Birde olmayan bir kod varsa mesela 20 yazdığım zaman o kodu bulamadığı için hata veriyor.

veyselemre · 2 Temmuz 2020

Hata için benim yapabileceğim bir şey yok, kodlarda standart dışı bir kullanım yok hata verecek, sizin versiyonunuzla veya ayarlarınızla ilgili olabilir mi bilmiyorum. Kodu inceleyen diğer arkadaşlar yorum yazarlarsa bilgi alınabilir.
Olmayan kod için de düzenleme yaptım, olmayan kod için 0 değerini dikkate alacak.

Kod:

Sub test2()
    Set sV = Sheets("VERİ KAYNAĞI")
    Set sA = Sheets("ANALİZ")
    sA.Range("D2:E" & Rows.Count).ClearContents
    liste = sV.Range("A2:E" & sV.Cells(Rows.Count, 1).End(3).Row).Value
    Dim w(1 To 2)

    With CreateObject("Scripting.Dictionary")
        For i = LBound(liste) To UBound(liste)
            For ii = 1 To 3
                al = Val(liste(i, ii))
                If .exists(al) Then
                    Z = .Item(al)
                    Z(1) = Z(1) + liste(i, 4)
                    Z(2) = Z(2) + liste(i, 5)
                    .Item(al) = Z
                Else
                    Z = w
                    Z(1) = liste(i, 4)
                    Z(2) = liste(i, 5)
                    .Item(al) = Z
                End If
            Next ii
        Next i
        sA.Select
        son = sA.Cells(Rows.Count, 1).End(3).Row
        For i = 2 To son
            Dim col As New Collection
            al = sA.Cells(i, 1)
            If al <> "" Then
                a = "="
                onc_nm = False
                For ii = 1 To Len(al)
                    b = Mid(al, ii, 1)
                    If IsNumeric(b) Or b = "." Then nm = True Else nm = False
                    If nm <> onc_nm Then
                        col.Add a
                        a = b
                    Else
                        a = a & b
                    End If
                    onc_nm = nm
                Next ii
                col.Add a

                f1 = ""
                f2 = ""
                If col.Count > 0 Then
                    For iii = 1 To col.Count
                        If IsNumeric(col(1)) And Len(col(1)) < 4 And InStr(col(1), ".") = 0 Then
                            If .exists(Val(col(1))) Then
                                Z = .Item(Val(col(1)))
                            Else
                                Z(1) = 0
                                Z(2) = 0
                            End If
                            f1 = f1 & Z(1)
                            f2 = f2 & Z(2)
                        Else
                            f1 = f1 & col(1)
                            f2 = f2 & col(1)
                        End If
                        col.Remove 1
                    Next iii
                End If
                sA.Cells(i, "D") = Evaluate(f1)
                sA.Cells(i, "E") = Evaluate(f2)
            End If
        Next i
    End With

End Sub

dengeceteris · 2 Temmuz 2020

Anladım dediğiniz gibi bir arkadaş yardımcı olursa umarım düzenleyebiliriz tşk ederim ilgi ve alakanız için..

dengeceteris · 2 Temmuz 2020

Acaba 64 bit 32 bit olması bir etkenmidir var mı bilgisi olan bir arkadaş

dengeceteris · 3 Temmuz 2020

Arkadaşlar buraya kadar geldik boşa gitmesin olayı inceledim büyük oranda çözdüm. Ama bir noktada yardıma ihtiyacım var. Benim VERİ KAYNAĞI sayfasında bulunan ve sonuç rakamlarının yazdığı C ve D sütunları başka sayfalardan sonuç olarak geliyor ve ben bunları çektikten sonra aşağıda ki gibi bir formata dönüştürüyorum ama sonuçlar 252.521,0898653 gibi virgülden sonra bir sürü karakter oluyor. bu formatı tam sayıya yuvarlayabilirsem yada virgülden sonrasını yok saydırırsam sonuç alabilirim.

S1.Range("C2" & Rows.Count).NumberFormat = "#,##0;(#,##0)"

Soru Kodlamada Aralık tanımlama

dengeceteris

Korhan Ayhan

Administrator

dengeceteris

Ekli dosyalar

veyselemre

Özel Üye

Ekli dosyalar

dengeceteris

veyselemre

Özel Üye

veyselemre

Özel Üye

dengeceteris

dengeceteris

Ekli dosyalar

veyselemre

Özel Üye

dengeceteris

veyselemre

Özel Üye

Ekli dosyalar

dengeceteris

veyselemre

Özel Üye

dengeceteris

dengeceteris

veyselemre

Özel Üye

Ekli dosyalar

dengeceteris

dengeceteris

dengeceteris