Makro İle Dizi Oluşturmak ve Kullanmak

[Ergün Güler]

Selam,
aşağıdaki kodlar ile dizi oluşturma ve bu diziyi başka yerlerde kullanmak istiyorum. Ancak yapamıyorum.
Yardımcı olabilirseniz çok sevinirim.
İyui çalışmalar.

[B]Sub üretim()
Dim dizi()

Set veri = Sheets("veri")
son = veri.Cells(65536, 1).End(3).Row

For i = 2 To son

If Month(veri.Cells(i, "C")) = 1 Then
dizi() = Array(veri.Cells(i, "B"))
End If

Next

End Sub[/B]

 

[Orion1]

Sub üretim()
Dim dizi(), a As Long, veri As Worksheet, son As Long, i As Long

Set veri = Sheets("veri")
son = Sheets("veri").Cells(65536, 1).End(3).Row
ReDim dizi(son)
For i = 2 To son
    If Month(Sheets("veri").Cells(i, "C")) = 1 Then
        dizi(a) = Array(Sheets("veri").Cells(i, "C"))
        a = a + 1
    End If
Next
'D sütunana diziyi yazar
ReDim Preserve dizi(a - 1)
For i = 0 To UBound(dizi)
    Sheets("veri").Cells(i + 2, "D").Value = dizi(i)
Next
End Sub

 

[Ergün Güler]

Selam,
Sayın Evren Gizlen Hocam, Çok Teşekkür ederim.Ellerinize sağlık.
Son gönderdiğiniz ve yine sizin önceki çözümlerinizden istifade ederek şöyle bir ön çalışma yaptım;

Sub üretim_2()
Dim dizi(), a As Long, veri As Worksheet, son As Long, i As Long

Set veri = Sheets("veri")
son = Sheets("veri").Cells(65536, 1).End(3).Row
ReDim dizi(son)

For i = 2 To son
    If Month(Sheets("veri").Cells(i, "C")) = 1 Then
        dizi(a) = Sheets("veri").Cells(i, "C")
        a = a + 1
    End If
Next

ReDim Preserve dizi(a)

MsgBox son
MsgBox UBound(dizi)
MsgBox dizi(24)
End Sub

Çok güzel oldu tam istediğim gibi. Fakat bir de aşağıdaki gibi yapayım dedim. Mavi alanları değiştirdim. Kırmızı alanda
Run-time error 9:
Subscript out of range hatasını verdi. Sebebi nedir?

Sub üretim_2()
Dim dizi(), a As Long, veri As Worksheet, son As Long, i As Long

Set veri = Sheets("veri")
son = Sheets("veri").Cells(65536, 1).End(3).Row
ReDim [B][COLOR="blue"]dizi(son, 1)[/COLOR][/B]

For i = 2 To son
    If Month(Sheets("veri").Cells(i, "C")) = 1 Then
        [COLOR="blue"][B]dizi(a, 1)[/B][/COLOR] = Sheets("veri").Cells(i, "C")
        a = a + 1
    End If
Next
[COLOR="Red"][B]
ReDim Preserve dizi(a, 1)[/B][/COLOR]

MsgBox son
MsgBox UBound(dizi)
MsgBox [COLOR="Blue"][B]dizi(24, 1)[/B][/COLOR]
End Sub

İyi çalışmalar.

 

[Orion1]

Sub üretim_2()
Dim dizi(), a As Long, veri As Worksheet, son As Long, i As Long

Set veri = Sheets("veri")
son = Sheets("veri").Cells(65536, 1).End(3).Row
ReDim dizi(1 To 1, 1 To son)

For i = 2 To son
    If Month(Sheets("veri").Cells(i, "C")) = 1 Then
        a = a + 1
        dizi(1, a) = Sheets("veri").Cells(i, "C")
    End If
Next

ReDim Preserve dizi(1 To 1, 1 To a)

MsgBox "Son : " & son & vbLf & "dizi eleman uzunluğu : " & _
UBound(dizi, 2) & vbLf & "Dizi Son elemanının verisi : " & dizi(1, UBound(dizi, 2))
End Sub

 

[Ergün Güler]

Sub üretim_2()
Dim dizi(), a As Long, veri As Worksheet, son As Long, i As Long

Set veri = Sheets("veri")
son = Sheets("veri").Cells(65536, 1).End(3).Row
ReDim dizi(1 To 1, 1 To son)

For i = 2 To son
    If Month(Sheets("veri").Cells(i, "C")) = 1 Then
        a = a + 1
        dizi(1, a) = Sheets("veri").Cells(i, "C")
    End If
Next

ReDim Preserve dizi(1 To 1, 1 To a)

MsgBox "Son : " & son & vbLf & "dizi eleman uzunluğu : " & _
UBound(dizi, 2) & vbLf & "Dizi Son elemanının verisi : " & dizi(1, UBound(dizi, 2))
End Sub

Selam Sayın Evren Gizlen hocam,
Çok çok teşekkür ederim. Sayenizde dizi oluşturmayı kısmen de olsa öğrenerek,

5-6 adet USERFORM'u ve 5-6 adet makroyu 1'e düşürdüm. Ne kadar kullanışlı imiş meğer bu dizi.

Musaadenizle birkaç sorum olacak cevaplayabilirseniz çok sevinirim;

dizi(1 To 1, 1 To son) ' 1 To 1 sütun , 1 To son ise satır bilgisi oluyor öyle değil mi?

UBound(dizi, 2) dizideki satır sayısı LBound(dizi, 2) ise ilk satır oluyor öyle değil mi?

UBound(dizi, 2)'daki 2 sayısı nedir anlayamadım.

ReDim dizi(1 To 1, 1 To son) daki 1 To Son'u yerine sadece Son yazsa idik dizi sıfır(0)'dan mı başlayacaktı?

Şimdiden çok teşekkürler ederim.
İyi çalışmalar.

 

[Orion1]

Selam Sayın Evren Gizlen hocam,
Çok çok teşekkür ederim. Sayenizde dizi oluşturmayı kısmen de olsa öğrenerek,

5-6 adet USERFORM'u ve 5-6 adet makroyu 1'e düşürdüm. Ne kadar kullanışlı imiş meğer bu dizi.

Musaadenizle birkaç sorum olacak cevaplayabilirseniz çok sevinirim;








Şimdiden çok teşekkürler ederim.
İyi çalışmalar.

ilk iki si doğru
2 demek 2nci boyutun sonunu öğrenmek demek.bu kaç satır varsa o sayıyı verir
2 yerine 1 yazsaydık sütun sayısını verirdi.
UBound(dizi, 2)'daki 2 sayısı nedir anlayamadım.
1 to son demek.satırn,dizinin 1 den başlayıp son değerine kadar veri alabilmesi demek

 

[Ergün Güler]

ilk iki si doğru
2 demek 2nci boyutun sonunu öğrenmek demek.bu kaç satır varsa o sayıyı verir
2 yerine 1 yazsaydık sütun sayısını verirdi.
UBound(dizi, 2)'daki 2 sayısı nedir anlayamadım.
1 to son demek.satırn,dizinin 1 den başlayıp son değerine kadar veri alabilmesi demek

Selam,
Sayın Evren Gizlen Hocam, Yardımlarınız ve açıklamalarınız için çok teşekkür ederim. İyi çalışmalar.

 

[Orion1]

Selam,
Sayın Evren Gizlen Hocam, Yardımlarınız ve açıklamalarınız için çok teşekkür ederim. İyi çalışmalar.

Hatırlatma
dizilerinizin ilk elemanının 1 olamsı için modülün en üstüne general kısmına
OPTION BASE 1
yazın.Bu durumda ilk elemanın indisi 1 olacktır.
Yazmaszanız ve 1 to diyede belirtmezseniz
ilk elamnın indisi sıfırdan başalr.
Ben genellikle bu option base 1 olayını kullanrım.
Kolay gelsin.

 

[Ergün Güler]

Hatırlatma
dizilerinizin ilk elemanının 1 olamsı için modülün en üstüne general kısmına
OPTION BASE 1
yazın.Bu durumda ilk elemanın indisi 1 olacktır.
Yazmaszanız ve 1 to diyede belirtmezseniz
ilk elamnın indisi sıfırdan başalr.
Ben genellikle bu option base 1 olayını kullanrım.
Kolay gelsin.

Çok Teşekkür ederim Sayın Gizlen Hocam,
Verdiğiniz bilgiler ile bir çok kodlarda değişiklik yaparak USERFORM ve MAKRO'ları azalttım. İnşallah Script Dictionary v.b. nesneleri de öğrenceğiz.

İyi çalışmalar.

 

[Orion1]

Çok Teşekkür ederim Sayın Gizlen Hocam,
Verdiğiniz bilgiler ile bir çok kodlarda değişiklik yaparak USERFORM ve MAKRO'ları azalttım. İnşallah Script Dictionary v.b. nesneleri de öğrenceğiz.

İyi çalışmalar.

Rica ederim.
İyi çalışmalar.

 

[Ergün Güler]

Selam Sayın Evren Gizlen,
Kafanızı yine ağrıtacağım;

aşağıdaki kodlar ile tek sütunlu dizi oluşturdum.

Public dizi

Public Sub günlük_plan()

Set veri = Sheets("veri-1")
son = veri.Cells(65536, "A").End(3).Row

ReDim dizi(1 To son)

For i = 2 To son
If WorksheetFunction.CountIf(veri.Range("A2:A" & i), veri.Cells(i, "A")) = 1 Then
   a = a + 1
   dizi(a) = veri.Cells(i, "A")
   End If
Next

ReDim Preserve dizi(1 To a)

End Sub

aşağı kodlarla ise ise DTpicker1'deki tarih dizi içinde yok ise
mesajla "yok" desin istedim ancak beceremedim. diziyi aralık gibi kullanamadım.

dizinin Lbound ile Ubound arasını örneğin Range("A1:A100") gibi nasıl kullanabilirim?
yardımcı olabliriseniz çok sevinirim.

Private Sub DTPicker1_Change()

If WorksheetFunction.CountIf([COLOR="Red"][B]dizi[/B][/COLOR], DTPicker1) = 0 Then
MsgBox "yok"
End If

End Sub

 

[Orion1]

Selam Sayın Evren Gizlen,
Kafanızı yine ağrıtacağım;

aşağıdaki kodlar ile tek sütunlu dizi oluşturdum.

Public dizi

Public Sub günlük_plan()

Set veri = Sheets("veri-1")
son = veri.Cells(65536, "A").End(3).Row

ReDim dizi(1 To son)

For i = 2 To son
If WorksheetFunction.CountIf(veri.Range("A2:A" & i), veri.Cells(i, "A")) = 1 Then
   a = a + 1
   dizi(a) = veri.Cells(i, "A")
   End If
Next

ReDim Preserve dizi(1 To a)

End Sub

aşağı kodlarla ise ise DTpicker1'deki tarih dizi içinde yok ise
mesajla "yok" desin istedim ancak beceremedim. diziyi aralık gibi kullanamadım.

dizinin Lbound ile Ubound arasını örneğin Range("A1:A100") gibi nasıl kullanabilirim?
yardımcı olabliriseniz çok sevinirim.

Private Sub DTPicker1_Change()

If WorksheetFunction.CountIf([COLOR="Red"][B]dizi[/B][/COLOR], DTPicker1) = 0 Then
MsgBox "yok"
End If

End Sub

Böyle olmaz döngüye grimeniz lazım tek tek sorgulamanız lazım.
Kullandığınız fonksiyon çalışma sayfasında kullanılır.Bir alan olması lazım ,(Range).
dizide alan toktur.
Ama bunun için cresteobjetc("Scripting.Dictionary") nesnesini tavsiye ederim.
Ben onu kullanıyorum.

 

[Ergün Güler]

Selam,
Açıklamalarınız için çok teşekkürler. Ancak, galiba ben tam olarak anlatamadım.
İlla WorksheetFunction içinde kullanmak istemedim. Şöyle anlatayım belki tam anlaşılır.
Nasıl ki
Range("A1")
Range("A2")
Range("A3")
veya
cells(1, "A")
cells(2, "A")
cells(3, "A")

aralık olarak Range("A1:A3") veya Range(cells(1, "A"), cells(3, "A")) kullanıyor.
Aynen öyle deTek sütunlu 6 satırlı bir dizimiz için
Dizi(1)
Dizi(2)
Dizi(3)
Dizi(4)
Dizi(5)
Dizi(6) gibi
Dizi(1:6) veya Dizi(1 to 6) v.b. ifade edilir mi? aralık gibi kullanılabilir mi?

 

[Orion1]

Selam,
Açıklamalarınız için çok teşekkürler. Ancak, galiba ben tam olarak anlatamadım.
İlla WorksheetFunction içinde kullanmak istemedim. Şöyle anlatayım belki tam anlaşılır.
Nasıl ki
Range("A1")
Range("A2")
Range("A3")
veya
cells(1, "A")
cells(2, "A")
cells(3, "A")

aralık olarak Range("A1:A3") veya Range(cells(1, "A"), cells(3, "A")) kullanıyor.
Aynen öyle deTek sütunlu 6 satırlı bir dizimiz için
Dizi(1)
Dizi(2)
Dizi(3)
Dizi(4)
Dizi(5)
Dizi(6) gibi
Dizi(1:6) veya Dizi(1 to 6) v.b. ifade edilir mi? aralık gibi kullanılabilir mi?

Hayır siz konuyu anlattınız.
Bende anladım.
Olmaz dedim zaten.İlaveten ilk elemandan son elemana kadar döngüye girip tek tek sorgulamanız gerektiğini söyledim zaten.
Bunlara ilave edilecek yeni bir şey yok.

 

[KarıncaZ]

Merhaba

Dizi oluşturma ile ilgili benimde içinden çıkamadığım bir sorum olacak.

İki sayfam mevcut. Yevmiye ve StandartSapma diye. Ben Standart sapma sayfasındaki her kod için bir arry list oluşturmak ve bu listenin standart sapmasını almak ve B ve C sütunlarına yazdırmak istiyorum.

Örnek StandarSapma Sayfasında 100.01.001 Hesabı için. Yevmiye sayfasında Hesap kodu bu kod ile aynı olanların Borç tutarlarını bir arry liste toplayacak Borç kısmı 0,00 ise dahil etmeyecek ve oluşan listenin Standart Sapmasını hesaplayacak ve StandartSapma Sayfasındaki B sütununa yazacak

Örnek dosya
http://s8.dosya.tc/server5/j5u6yw/OrnekDosya.xlsx.html

Yardımlarınız için şimdiden teşekkürler

 

[KarıncaZ]

Dizi oluşturup Standart sapmasını hesaplatmak istiyorum ancak hesaplamıyor #Sayı!0 hatası alıyorum. Yardımcı olabilir misiniz.


Sub Dizi()
Dim Dizi(), a As Long, veri As Worksheet, son As Long, i As Long

Set S1 = Sheets("Yevmiye")
Set S2 = Sheets("StandartSapma")
son1 = S1.Range("A1048576").End(xlUp).Row
son2 = S2.Range("A1048576").End(xlUp).Row

ReDim Dizi(son1)

For j = 3 To son2
For i = 4 To son1
If S1.Cells(i, "B").Value = S2.Cells(i, "A").Value Then
Dizi(a) = Array(S1.Cells(i, "E"))
a = a + 1
End If
Next
Ss = Application.StDev(Dizi(a)) 'Dizi nin Standart Sapmasını Hesaplama
S2.Cells(j, "B").Value = Ss
Next

End Sub

 

[PLİNT]

Dizi oluşturup Standart sapmasını hesaplatmak istiyorum ancak hesaplamıyor #Sayı!0 hatası alıyorum. Yardımcı olabilir misiniz.

Merhaba
Yukarıda kodlar aşağıdaki gibi düzenlenebilir;

[SIZE="2"]Sub Dizi()
Dim Dizi(), a As Long, veri As Worksheet, son As Long, i As Long
Dim s1 As Worksheet, s2 As Worksheet
Set s1 = Sheets("Yevmiye")
Set s2 = Sheets("StandartSapma")
son1 = s1.Range("A1048576").End(xlUp).Row
son2 = s2.Range("A1048576").End(xlUp).Row
For j = 3 To son2
a = 0
ReDim Dizi(son1)
For i = 4 To son1
If Trim(s1.Cells(i, "B")) = Trim(s2.Cells(j, "A")) Then
Dizi(a) = s1.Cells(i, "E").Value
a = a + 1
End If
Next
ReDim Preserve Dizi(a)
Ss = Application.StDev(Dizi) 'Dizi nin Standart Sapmasını Hesaplama
s2.Cells(j, "B").Value = Ss
Erase Dizi
Next
End Sub [/SIZE]

ama bu kodların yerine (örnek dosyanıza göre); aşağıdaki kodlarla daha hızlı sonuç alabilirsiniz.

[SIZE="2"]Sub Dizi()
Dim j As Long
Dim s1 As Worksheet, s2 As Worksheet
Set s1 = Sheets("Yevmiye")
Set s2 = Sheets("StandartSapma") 'son1 = S1.Range("A1048576").End(xlUp).Row
son1 = s1.Range("A1048576").End(xlUp).Row
son2 = s2.Range("A1048576").End(xlUp).Row
For j = 3 To son2
s1.Range("A3:F" & son1).AutoFilter Field:=2, Criteria1:=Trim(s2.Cells(j, "A"))
s2.Cells(j, "B").Value = Application.StDev(s1.Range("E4:E" & son1).SpecialCells(xlCellTypeVisible).Cells)
's2.Cells(j, "C").Value = Application.StDev(s1.Range("F4:F" & son1).SpecialCells(xlCellTypeVisible).Cells)
s2.Cells(j, 2).Select
Next
s1.Range("A3:F" & son1).AutoFilter Field:=2
End Sub [/SIZE]

 

[KarıncaZ]

Merhaba Sayın PLİNT

Yardımınız için teşekkürler. Benim kodlarımda çalışıyor ancak veriler çoğalınca excel yanıt vermiyor.

Sizin kodlarınız da bu sorun oluşmuyor.

Mesleğimiz gereği büyük veri yığınlarıyla çalışıyoruz, sizin yapmış olduğunuz gibi hızlı çalışan yada bilgisayarı yormayan kod yazmak için nelere dikkat etmemiz gerekiyor.

Bazı programlama dillerinde kodu analiz yapabileceğiniz programcıklar var farklı ve hızlı çalışacak yöntemleri de gösteriyor. Excel Vba için böyle bir program var mı?

Esenlikler dilerim. İyi çalışmalar.

 

[canburak]

Merhabalar, Veri kaydetme ile ilgili yapmaya calistigim makrolar var, simdilik isimi 3 ayri makro ile coze bildim ancak, Bu makrolari daha basit ve hizli bir sekilde calismasini nasil yapa bilirim? Dizi yapisini kullanarak "Dizi = CreateObject("Scripting.Dictionary")" Yardimlariniz bekliyorum Tesekkurler simdiden.
Sub Listeye_Gir()
Dim i, son As Long

Set s1 = Sheets("Liste")
Set s2 = Sheets("Maliyet")
son = s2.Cells(Rows.Count, 1).End(3).Row ' xlUp
Max = Application.WorksheetFunction.Max(Sheets("Liste").Range("A:A"), 1)
say = s1.Cells(Rows.Count, 1).End(3).Row + 1
For i = 5 To son
If s2.Cells(i, 1) <> "" Then

s2.Cells(2, 7).Value = Max + 1
s1.Cells(say, 1).Value = s2.Cells(2, 7).Value ' FIS NO
s1.Cells(say, 3).Value = s2.Cells(3, 1).Value ' TARIH
s1.Cells(say, 5).Value = "621" & " " & s2.Cells(3, 3).Value
s1.Cells(say, 21).Value = s2.Cells(i, 1).Value ' TMK
s1.Cells(say, 7).Value = s2.Cells(i, 2).Value ' ANA
s1.Cells(say, 8).Value = s2.Cells(i, 3).Value ' ALT
s1.Cells(say, 11).Value = s2.Cells(i, 4).Value ' ALACAK
s1.Cells(say, 14).Value = -s2.Cells(i, 5).Value ' USD
s1.Cells(say, 6).Value = 1 + i ' FISI SIRALAMAK ICIN SERI NO SONRA SIL , ama siralatamadik
s1.Cells(say, 19).Value = s2.Cells(i, 6).Value ' ALIS LOT
s1.Cells(say, 20).Value = s2.Cells(i, 7).Value ' SATIS LOT
s1.Cells(say, 18).Value = s2.Cells(i, 8).Value ' KNT
s1.Cells(say, 6).Value = 1 + i
say = say + 1

End If
Next i
Call BosSatiraC
End Sub

Sub BosSatiraC() ' Listede bos satir acmak icin
Dim a As Integer
Set s1 = Sheets("Liste")
Set s2 = Sheets("Maliyet")

For a = s1.Range("A65536").End(xlUp).Row To 2 Step -1
If s1.Cells(a, 1) <> "" And s1.Cells(a, 1) = s2.Range("G2") Then
s1.Rows(a + 1 & ":" & a + 1).Insert 'KaC bos stir eklenecek'.
End If
Next a
Call Karsi_Hs_Doldur
End Sub


Sub Karsi_Hs_Doldur() ' 621 LERI YERLESTIR
Dim i, son As Long
Set s1 = Sheets("Liste")
Set s2 = Sheets("Maliyet")
son = s1.Cells(Rows.Count, 1).End(3).Row ' xlUp

For i = 2 To son
If s1.Cells(i, 1) = "" Then

s1.Cells(i, 21).Value = "621"
s1.Cells(i, 1).Value = s1.Cells(i - 1, 1).Value
s1.Cells(i, 3).Value = s1.Cells(i - 1, 3).Value
s1.Cells(i, 7).Value = "SATILAN MALIN MALIYETI"
s1.Cells(i, 8).Value = "621" & " " & s2.Cells(3, 3).Value
s1.Cells(i, 10).Value = s1.Cells(i - 1, 11).Value
s1.Cells(i, 14).Value = -s1.Cells(i - 1, 14).Value
s1.Cells(i, 6).Value = s1.Cells(i - 1, 6).Value - 0.1
s1.Cells(i, 5).Value = s1.Cells(i - 1, 8).Value
s1.Cells(i, 19).Value = s1.Cells(i - 1, 19).Value
s1.Cells(i, 20).Value = s1.Cells(i - 1, 20).Value

Else
If s1.Cells(i, 21) = 153 Or s1.Cells(i, 21) = 156 Then '
s1.Cells(i, 20).Value = s2.Cells(3, 5).Value ' alim giderine SATIS LOT
End If
End If

Next i

For songiris = 2 To son ' son satir eksik geldigi icin burayi eklemek zorunda kaldim
If s1.Cells(i, 21) <> "621" Then

s1.Cells(i, 21).Value = "621"
s1.Cells(i, 1).Value = s1.Cells(i - 1, 1).Value
s1.Cells(i, 3).Value = s1.Cells(i - 1, 3).Value
s1.Cells(i, 7).Value = "SATILAN MALIN MALIYETI"
s1.Cells(i, 8).Value = "621" & " " & s2.Cells(3, 3).Value
s1.Cells(i, 10).Value = s1.Cells(i - 1, 11).Value
s1.Cells(i, 14).Value = -s1.Cells(i - 1, 14).Value
s1.Cells(i, 6).Value = s1.Cells(i - 1, 6).Value - 0.1
s1.Cells(i, 5).Value = s1.Cells(i - 1, 8).Value
s1.Cells(i, 19).Value = s1.Cells(i - 1, 19).Value
s1.Cells(i, 20).Value = s1.Cells(i - 1, 20).Value

Else
If s1.Cells(i, 21) = 153 Or s1.Cells(i, 21) = 156 Then '
s1.Cells(i, 20).Value = s2.Cells(3, 5).Value ' alim giderine SATIS LOT
End If
End If
Next songiris
If son > 0 Then
Range("J2").Resize(son, 5).Style = "Comma"
End If
End Sub