Spor Toto Vba Düzenleme ve güncelleme

VBA Makrolar ile ilgili sormak istedikleriniz, yapmak istedikleriniz hakkında yardım alabileceğiniz bölümdür.

Spor Toto Vba Düzenleme ve güncelleme

İleti#1)  mehmetserkanaksel » 11 Oca 2020 14:48

Merhabalar;

Ben spor toto ile ilgili bir çalışma yaptırmak ve ücreti karşılığında bu çalışmayı satın almak istiyorum.

İstediğim çalışmanın aşağıdaki alana kısa bir örneğini yazıyorum. Yardımcı olabilecek arkadaşlar varsa emeğinin karşılığı da verilmek üzere desteğini bekliyorum.


Örnek; 100 kolonluk bir çalışma sayfası var. 15 satırlık alanda (15 maç) farklı kombinasyonlarda benzersiz olması kaydı ile benim belirlediğim kadar tercihleri dağıtacak, Örneğin; A takımı, B takımı ile maç yapacak, bu maçların 7 farklı kombinasyonu mevcut. ( 1 - 0 - 2 - 10 - 02 - 12 - 102 gibi ) bu seçeneklerden 40 adet 1 versin 50 adet 2 versin 10 adet 12 versin gibi... Bu sonuçlara göre 100 kolona farklı ve birbirinden benzersiz olması kaydı ile vba ile 15 satırın hepsini dağıtmasını istiyorum.

Örnek bir çalışmayı ek dosya olarak ta ekledim.
Bu iletideki ekleri görmek için gerekli yetkilere sahip değilsiniz.
Kullanıcı avatarı
mehmetserkanaksel
 
Kayıt: 11 Oca 2020 14:09
Meslek: Sağlık memuru
Yaş: 33
İleti: 6
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: burdur / bucak

Cevap: Spor Toto Vba Düzenleme ve güncelleme

İleti#2)  mehmetserkanaksel » 16 Oca 2020 18:13

Bu kadar excel uzmanı ve ilgilisi, yetkilisi varken, bir kişi bile yok mu bunu yapabilecek. En azından uzman bir kişi çıksın desin ki arkadaş senin istediğini bu sitede yapamıyoruz ve ya yapmıyoruz. Yada moderatör / admin söylesin başka siteye git veya şu kişi yapar yada şu sitede yardımcı olurlar desin.

Lütfen en azından bir yetkili olumlu olumsuz cevap versin. ilgisiz alakasız gibi oldu bu açtığımız konu..
Kullanıcı avatarı
mehmetserkanaksel
 
Kayıt: 11 Oca 2020 14:09
Meslek: Sağlık memuru
Yaş: 33
İleti: 6
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: burdur / bucak

Cevap: Cevap: Spor Toto Vba Düzenleme ve güncelleme

İleti#3)  Miraç CAN » 17 Oca 2020 10:04

mehmetserkanaksel yazdı:Bu kadar excel uzmanı ve ilgilisi, yetkilisi varken, bir kişi bile yok mu bunu yapabilecek. En azından uzman bir kişi çıksın desin ki arkadaş senin istediğini bu sitede yapamıyoruz ve ya yapmıyoruz. Yada moderatör / admin söylesin başka siteye git veya şu kişi yapar yada şu sitede yardımcı olurlar desin.

Lütfen en azından bir yetkili olumlu olumsuz cevap versin. ilgisiz alakasız gibi oldu bu açtığımız konu..

Merhaba,
Merak ettim açıkçası; olur mu, yapılabilir mi, yapabilir miyim?
Bu işlerde çokta usta değilim, merakımı gideririm, belki yeni şeyler keşfederim.
Zaman buldukça kurcalıyorum bakalım?
Kullanıcı avatarı
Miraç CAN
Siteye Alışmış
 
Kayıt: 26 Arl 2016 19:07
Meslek: Harita/Ölçme
Yaş: 38
İleti: 105
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: İstanbul / Beşiktaş

Cevap: Spor Toto Vba Düzenleme ve güncelleme

İleti#4)  ahmetilhan282 » 18 Oca 2020 18:02

tam anlamadım ama anladığım kadarını çözdüm
kodlar:
Kod: Tümünü seç
Sub deneme()
    Range("T3:JI17").ClearContents
    Application.ScreenUpdating = False
    For satir = 3 To 17
        For sutun = 7 To 13
            If Cells(satir, sutun).Value > 0 Then
                ihtimaller = Cells(satir, sutun)
                For j = 1 To ihtimaller
                    Cells(satir, Columns.Count).End(xlToLeft).Offset(0, 1) = Cells(2, sutun)
                Next j
            End If
        Next sutun
    Next satir
    Application.ScreenUpdating = True
    MsgBox "İşlem Tamamlandı.", vbInformation, "BİLGİ"
End Sub
Bu iletideki ekleri görmek için gerekli yetkilere sahip değilsiniz.
Kullanıcı avatarı
ahmetilhan282
Site Dostu
 
Adı Soyadı:Ahmet İLHAN
Kayıt: 15 Oca 2014 00:04
Konum: Adana
Meslek: Güvenlik
Yaş: 30
İleti: 887
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Mersin

REKLAM
Excel Logo XML Oluşturucu
Logo Object Designer ile Uyarlama

Cevap: Spor Toto Vba Düzenleme ve güncelleme

İleti#5)  mehmetserkanaksel » 18 Oca 2020 18:08

İlgilenen arkadaşlar için tekrar dan bi liste göndereyim.. Bİ inceleyin isterseniz.. Benim elimde bir kod var bu kod 24 kolonluk oluşturuyor ama ben 250 kolonluk istiyorum. Bunu kodu benim excel de belirttiğim alanlara uyarlayabilr miyiz. hem sizin için kolaylık olur bir yol gösterici olur hemde benim için zaman kazandırmış olur..
Bu iletideki ekleri görmek için gerekli yetkilere sahip değilsiniz.
Kullanıcı avatarı
mehmetserkanaksel
 
Kayıt: 11 Oca 2020 14:09
Meslek: Sağlık memuru
Yaş: 33
İleti: 6
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: burdur / bucak

Cevap: Spor Toto Vba Düzenleme ve güncelleme

İleti#6)  mehmetserkanaksel » 18 Oca 2020 18:12

Birde 24 kolon dediğim sistemi size göndereyim bi inceleyin isterseniz.. Bu sistemi benim dediğim excele uyarlamam lazım..
Bu iletideki ekleri görmek için gerekli yetkilere sahip değilsiniz.
Kullanıcı avatarı
mehmetserkanaksel
 
Kayıt: 11 Oca 2020 14:09
Meslek: Sağlık memuru
Yaş: 33
İleti: 6
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: burdur / bucak

REKLAM
ETA - Excel Konsolide Raporlama
ETA Excel Personel Entegre Raporu

Cevap: Spor Toto Vba Düzenleme ve güncelleme

İleti#7)  mehmetserkanaksel » 18 Oca 2020 18:18

Miraç Can; İlgin için teşekkür ederim. Yardımcı olabilirsen memnun olurum.

Ahmet İlhan; Senin yaptığın olmuş ama bu sistemde sıralı değil rastgele ve benzersiz şekilde vermesi lazım, yani 1 lerin hepsini aynı anda 0 ların hepsini arkasına ve 2 lerin hepsini arkasına eklemiş.

Burda ki amaç; 100 adet 1 seçeneği varsa 100 adet 2 seçeneği varsa 50 adet de 0 seçeneği varsa ilk maçta sonuç 1 gelmiş olsun.
2. maçta da aynı şekilde rastgele dağıtmış olduğu zaman 1 de gelse 0 da gelse 2 de gelse yukarıda ki 1 seçeneği gelen alanlardan herhangi birinde bu sonuçların olması lazım.. benim size örnek dosyada gönderdiğim gibi dağınık ve benzersiz olması lazım..

Spor Toto kolon v2 dosyasında gönderdiğim dosyada deneme yaparsanız rastgele verdiğini göreceksiniz.

Bu şekilde tekrar bi bakabilir misiniz, teşekkür ederim şimdiden..
Kullanıcı avatarı
mehmetserkanaksel
 
Kayıt: 11 Oca 2020 14:09
Meslek: Sağlık memuru
Yaş: 33
İleti: 6
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: burdur / bucak

Cevap: Spor Toto Vba Düzenleme ve güncelleme

İleti#8)  ahmetilhan282 » 18 Oca 2020 21:26

o dosyadaki kodları sizin dosyanıza uyarladım
Kod: Tümünü seç
Option Explicit
Sub TotoKuponu_Hsayar()
'IIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIII
'IIIIIIIIII]      Çalışma Sayfasının DEF sütunlarına girilen değerleri baz alarak       [IIIIIIIIII
'IIIIIIIIII]      H-DC Sütunlarına rastgele 1,0,2 değerlerini dağıtır.                   [IIIIIIIIII
'\\ <<=H=>> <<=S=>> <<=A=>> <<=Y=>> <<=A=>> <<=R=>> <<=™=>>           <<=09/11/2008=>>  <<=13:50=>>
'IIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIII§
Application.ScreenUpdating = False
Dim snlSat() As String, snlsatTemp() As String, ihtimaller As Variant, tablo As Variant, msg As String
msg = "İşlem Tamamlandı."
Dim data As Variant
Dim i%, ii%, iStn%, iStr%, h&
ihtimaller = Split("G:M", ":")
tablo = Split("T:JI", ":")
    With Me
        .Range(tablo(0) & "3:" & tablo(1) & 17).ClearContents

        For iStr = 3 To 17
        If Application.WorksheetFunction.Sum(.Range(ihtimaller(0) & iStr & ":" & ihtimaller(1) & iStr)) <> 250 Then
            .Range(ihtimaller(0) & iStr & ":" & ihtimaller(1) & iStr).Activate
            msg = "Değerler toplamı 250 olmalıdır."
            GoTo bitis
        End If

        For iStn = .Range(tablo(0) & 1).Column To .Range(tablo(1) & 1).Column
            i = i + 1
            ReDim Preserve snlSat(1 To i)
            snlSat(i) = .Cells(iStr, iStn).Address   ' adresleri diziye aldık.
        Next iStn

        For h = .Range(ihtimaller(0) & 1).Column To .Range(ihtimaller(1) & 1).Column
            If .Cells(iStr, h) > 0 Then
                data = UniqueRandomNumbers(.Cells(iStr, h), 1, UBound(snlSat))  'kaçadet yerleşecek, başlangıç no, bitiş no
                For i = 1 To .Cells(iStr, h)    'yerleştime işlemine başladık.
                    .Range(snlSat(data(i))).Value = .Cells(2, h)   'kura sonucu belirlenen numara sanal satırımızdaki hangi adrese karşılık geliyorsa ona yazıyoruz.
                    snlSat(data(i)) = Empty             'tekrar kullanmamak için boşaltıyoruz.
                Next i
                For i = LBound(snlSat) To UBound(snlSat)  'Kullandıklarımızı diziden çıkartıp geçici diziye alacağzı, sonra gerçek dizimize geri vereceğiz.
                    If snlSat(i) <> Empty Then
                    ii = ii + 1
                    ReDim Preserve snlsatTemp(1 To ii)
                    snlsatTemp(ii) = snlSat(i)
                    End If
                Next i
                i = 0: ii = 0
                snlSat = snlsatTemp
                Erase snlsatTemp(), data
            End If
        Next h
        Erase snlSat()

        Next iStr
    End With
bitis:
    Application.ScreenUpdating = True
    MsgBox msg, vbInformation, "BİLGİ"
    i = Empty: ii = Empty: iStn = Empty: iStr = Empty: h = Empty
End Sub
Function UniqueRandomNumbers(KacAdetSayi As Long, EnKucukSayi As Long, EnBuyukSayi As Long) As Variant
    Dim RandColl As Collection, varTemp() As Long
    Dim k&, i&, j&
    UniqueRandomNumbers = False
     
    If KacAdetSayi < 1 Then Exit Function
    If EnKucukSayi > EnBuyukSayi Then Exit Function
    If KacAdetSayi > (EnBuyukSayi - EnKucukSayi + 1) Then Exit Function
    Set RandColl = New Collection
    Randomize
    Do
        On Error Resume Next
        i = CLng(Rnd * (EnBuyukSayi - EnKucukSayi) + EnKucukSayi)
        RandColl.Add i, CStr(i)
        On Error GoTo 0
    Loop Until RandColl.Count = KacAdetSayi
       
    ReDim varTemp(1 To KacAdetSayi)
   
    For i = 1 To KacAdetSayi
        varTemp(i) = RandColl(i)
    Next i
   
    For i = 1 To KacAdetSayi - 1
        For j = i + 1 To KacAdetSayi
            If varTemp(i) > varTemp(j) Then
                'Switch(varTemp(i),varTemp(j))
                k = varTemp(i)
                varTemp(i) = varTemp(j)
                varTemp(j) = k
            End If
        Next j
    Next i
   
    Set RandColl = Nothing
    UniqueRandomNumbers = varTemp
    Erase varTemp
    k = 0: i = 0: j = 0
End Function
Kullanıcı avatarı
ahmetilhan282
Site Dostu
 
Adı Soyadı:Ahmet İLHAN
Kayıt: 15 Oca 2014 00:04
Konum: Adana
Meslek: Güvenlik
Yaş: 30
İleti: 887
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Mersin

Cevap: Spor Toto Vba Düzenleme ve güncelleme

İleti#9)  mehmetserkanaksel » 20 Oca 2020 11:22

Değerli kardeşim; ben vba konusunda çok amatörüm, deniyorum ama devamlı olarak hata veriyor. bu konuda excel tablosunun içine yerleştirilmiş şekilde yollayabilir misin. Ben yerleştiriyorum çalıştır dediğim farklı bir hata veriyor. Anlayamadım.
Kullanıcı avatarı
mehmetserkanaksel
 
Kayıt: 11 Oca 2020 14:09
Meslek: Sağlık memuru
Yaş: 33
İleti: 6
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: burdur / bucak

Cevap: Cevap: Spor Toto Vba Düzenleme ve güncelleme

İleti#10)  ahmetilhan282 » 26 Oca 2020 12:09

mehmetserkanaksel yazdı:Değerli kardeşim; ben vba konusunda çok amatörüm, deniyorum ama devamlı olarak hata veriyor. bu konuda excel tablosunun içine yerleştirilmiş şekilde yollayabilir misin. Ben yerleştiriyorum çalıştır dediğim farklı bir hata veriyor. Anlayamadım.
Bu iletideki ekleri görmek için gerekli yetkilere sahip değilsiniz.
Kullanıcı avatarı
ahmetilhan282
Site Dostu
 
Adı Soyadı:Ahmet İLHAN
Kayıt: 15 Oca 2014 00:04
Konum: Adana
Meslek: Güvenlik
Yaş: 30
İleti: 887
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Mersin


Forum Genel Makro Soruları

Online Kullanıcılar

Bu forumu görüntüleyenler: AhrefsBot ve 0 misafir

cron
Bumerang - Yazarkafe