UserFormda ETOPLA problemi

Durum
Üzgünüz bu konu cevaplar için kapatılmıştır...
V

vardar07

Destek Ekibi
Destek Ekibi
Katılım
19 Mart 2008
Mesajlar
2,154
Excel Vers. ve Dili
Office 2007 Enterprise
Türkçe
UserFormda ETOPLA

Merhaba, Arkadaşlar. Userformda Textboxlara etopla formulünü uygulama şansımız varmı.Varsa nasıl yapabiliriz.
 
Son düzenleme:
S

suleyman242

Katılım
21 Ekim 2010
Mesajlar
865
Excel Vers. ve Dili
türkçe 2010
Altın Üyelik Bitiş Tarihi
24/05/2018
vardar07' Alıntı:
Merhaba, Arkadaşlar. Userformda Textboxlara etopla formulünü uygulama şansımız varmı.Varsa nasıl yapabiliriz.
Genişletmek için tıkla ...
bir örnek yolluyorum
üç adet textbox 1,2,3 ve command button
textboxlara sayı gir ve sonucu verir
bu şekil işine yararmı ?
Kod: 
Dim i, deger
deger = 0
    For i = 1 To 3
        With UserForm1
        If Controls("textbox" & i).Value <> 0 Then
            deger = deger + Controls("TextBox" & i).Value
        End If
        End With
    Next
MsgBox "deger=" & deger
 

Ekli dosyalar

V

vardar07

Destek Ekibi
Destek Ekibi
Katılım
19 Mart 2008
Mesajlar
2,154
Excel Vers. ve Dili
Office 2007 Enterprise
Türkçe
Arkadaşım öncelikle ilgine teşekkürler. Konu açıklaması benim hatamdan dolayı eksik olmuş. Yapmak istediğim. Hücrelerdeki formülleri
H2 deki kod
Kod: 
=ETOPLA($B$2:$B$21;AA2;$E$2:$E$21)
I2 deki kod
Kod: 
=ETOPLA($B$2:$B$21;AA2;$D$2:$D$21)
J2 deki kod
Kod: 
[COLOR="Red"][B]=$H$2-$I$2[/B][/COLOR]
textboxta göstermek sonuç kırmızılı yer. Range ile textboxta gösteriyoruz ama osyada formül olmasın diye böyle bir yola başvurdum.
 
Son düzenleme:
Orion1

Orion1

Uzman
Uzman
Katılım
1 Mart 2005
Mesajlar
22,248
Excel Vers. ve Dili
Win7 Home Basic TR 64 Bit

Ofis-2010-TR 32 Bit
ilk etopla için aşağıdaki kodu yazdım.Diğerlerinide siz yapın.:cool:
Kod: 
Sub etopla59()
Dim deg1 As Double
deg1 = WorksheetFunction.SumIf(Range("B2:B21"), Range("AA2").Value, Range("E2:E21"))
MsgBox deg1
End Sub
 
V

vardar07

Destek Ekibi
Destek Ekibi
Katılım
19 Mart 2008
Mesajlar
2,154
Excel Vers. ve Dili
Office 2007 Enterprise
Türkçe
Orion1' Alıntı:
ilk etopla için aşağıdaki kodu yazdım.Diğerlerinide siz yapın.:cool:
Genişletmek için tıkla ...
Merhaba, Orion1 çok teşekkürler. Aşağıdaki kodda Textbox içinde göstermesi doğru bir şekilmi acaba. daha başka kısa yolu varmı.
Kod: 
Private Sub TextBox1_Enter()
Dim deg1,deg2, deg3 As Double
deg1 = WorksheetFunction.SumIf(Range("B2:B21"), Range("AA2").Value, Range("E2:E21"))
deg2 = WorksheetFunction.SumIf(Range("B2:B21"), Range("AA2").Value, Range("d2:d21"))
deg3 = deg1 - deg2
TextBox4 = Format(deg3, "#,##0")&"   TL"
End Sub
 
Orion1

Orion1

Uzman
Uzman
Katılım
1 Mart 2005
Mesajlar
22,248
Excel Vers. ve Dili
Win7 Home Basic TR 64 Bit

Ofis-2010-TR 32 Bit
vardar07' Alıntı:
Merhaba, Orion1 çok teşekkürler. Aşağıdaki kodda Textbox içinde göstermesi doğru bir şekilmi acaba. daha başka kısa yolu varmı.
Kod: 
Private Sub TextBox1_Enter()
Dim deg1,deg2, deg3 As Double
deg1 = WorksheetFunction.SumIf(Range("B2:B21"), Range("AA2").Value, Range("E2:E21"))
deg2 = WorksheetFunction.SumIf(Range("B2:B21"), Range("AA2").Value, Range("d2:d21"))
deg3 = deg1 - deg2
TextBox4 = Format(deg3, "#,##0")&"   TL"
End Sub
Genişletmek için tıkla ...
Evet yazdığınız kod doğrudur.
Kolay gelsin.
 
V

vardar07

Destek Ekibi
Destek Ekibi
Katılım
19 Mart 2008
Mesajlar
2,154
Excel Vers. ve Dili
Office 2007 Enterprise
Türkçe
Orion1' Alıntı:
Evet yazdığınız kod doğrudur.
Kolay gelsin.
Genişletmek için tıkla ...
Affınıza sığınarak bu şekilde 4 adet textboxa işlem yaptırıyoruz,Formulü kısaltmanın bir yolu varmı.
Herşey için teşekkür.Sizede kolay gelsin.
 
Orion1

Orion1

Uzman
Uzman
Katılım
1 Mart 2005
Mesajlar
22,248
Excel Vers. ve Dili
Win7 Home Basic TR 64 Bit

Ofis-2010-TR 32 Bit
vardar07' Alıntı:
Affınıza sığınarak bu şekilde 4 adet textboxa işlem yaptırıyoruz,Formulü kısaltmanın bir yolu varmı.
Herşey için teşekkür.Sizede kolay gelsin.
Genişletmek için tıkla ...
belki döngü olabilir.Diğer kodlarıda görmek lazım.
Yani textboxların verileri aldığı kodlarıda.
 
V

vardar07

Destek Ekibi
Destek Ekibi
Katılım
19 Mart 2008
Mesajlar
2,154
Excel Vers. ve Dili
Office 2007 Enterprise
Türkçe
Kodlar aşağıdaki gibi
Kod: 
Private Sub Calendar1_Click()
TextBox1.Value = Format(Calendar1.Value, "dd.mm.yyyy")
Frame1.Visible = False

End Sub
Private Sub comboBox1_Change()
If CheckBox1 = True Then: TextBox4.BackColor = &HFFFF&
Label5.Caption = ComboBox1.Text
etopla59
End Sub

Private Sub CheckBox1_Change()
If CheckBox1 = True Then
Label3 = Range("veri! d1")
Else
Label3 = Range("veri! e1")
End If

End Sub

Private Sub CommandButton1_Click()
   If ComboBox1.Text <> "" And TextBox1.Value <> "" And TextBox1.Value <> "" Then
    Son_Dolu_Satir = Sheets("veri").Range("A65536").End(xlUp).Row
    Bos_Satir = Son_Dolu_Satir + 1
    Sheets("veri").Range("a" & Bos_Satir).Value = _
                   Application.WorksheetFunction.Max(Sheets("veri").Range("a:a")) + 1
    Sheets("veri").Range("b" & Bos_Satir).Value = ComboBox1.Text
    Sheets("veri").Range("c" & Bos_Satir).Value = TextBox1.Text
    If CheckBox1 = True Then
    Sheets("veri").Range("d" & Bos_Satir).Value = TextBox2.Text
    Else
    Sheets("veri").Range("e" & Bos_Satir).Value = TextBox2.Text
    End If
    Sheets("veri").Select
    Else
    MsgBox "GİRİŞLER BOŞ GEÇİLMEZ"
    TextBox1 = "": TextBox2 = ""
    End If
etopla59
End Sub

Private Sub CommandButton2_Click()
Unload Me
End Sub

Private Sub TextBox1_Enter()
Frame1.Visible = True
End Sub

Sub etopla59()
Dim deg1, deg2, deg3, deg4, deg5, deg6 As Double
deg1 = WorksheetFunction.SumIf(Range("B2:B200"), Range("AA2").Value, Range("E2:E200"))
deg2 = WorksheetFunction.SumIf(Range("B2:B200"), Range("AA2").Value, Range("d2:d200"))
deg3 = Format((deg1 - deg2), "#,##0") & "  TL"
deg4 = WorksheetFunction.SumIf(Range("B2:B200"), Range("AA3").Value, Range("E2:E200"))
deg5 = WorksheetFunction.SumIf(Range("B2:B200"), Range("AA3").Value, Range("d2:d200"))
deg6 = deg4 - deg5
deg7 = WorksheetFunction.SumIf(Range("B2:B200"), Range("AA4").Value, Range("E2:E200"))
deg8 = WorksheetFunction.SumIf(Range("B2:B200"), Range("AA4").Value, Range("d2:d200"))
deg9 = deg7 - deg8
deg10 = WorksheetFunction.SumIf(Range("B2:B200"), Range("AA5").Value, Range("E2:E200"))
deg11 = WorksheetFunction.SumIf(Range("B2:B200"), Range("AA5").Value, Range("d2:d200"))
deg12 = deg10 - deg11
If ComboBox1 = "Harun" Then: TextBox4 = deg3
If ComboBox1 = "Kenan" Then: TextBox4 = deg6
If ComboBox1 = "Yaşar" Then: TextBox4 = deg9
If ComboBox1 = "Seyhun" Then: TextBox4 = deg12
End Sub

Private Sub UserForm_Initialize()
UserForm2.Caption = "TOPLAM ALACAK/VERECEK    " & Format(Now, "DD.MM.YYYY    SS:MM")
Frame1.Visible = False
Frame1.Top = TextBox1.Top
Frame1.Left = TextBox1.Left
ComboBox1.RowSource = "veri!aa2:aa" & [veri!aa65536].End(3).Row
Label1.Caption = Range("veri!B1")
Label2.Caption = Range("veri!C1")

End Sub
 

Ekli dosyalar

Orion1

Orion1

Uzman
Uzman
Katılım
1 Mart 2005
Mesajlar
22,248
Excel Vers. ve Dili
Win7 Home Basic TR 64 Bit

Ofis-2010-TR 32 Bit
Gördüğüm kadarı ile bu şekilde Olacak.Daha kısaltılacağını sanmıyorum.
Kolay gelsin.
 
V

vardar07

Destek Ekibi
Destek Ekibi
Katılım
19 Mart 2008
Mesajlar
2,154
Excel Vers. ve Dili
Office 2007 Enterprise
Türkçe
Sayın Orion1 teşekkürler. Yeri değil ancak bir çalışmanızda, listview süzmede aşağıdaki kod veri az olursa sorun yok yalnız 50.000 lik bir veride çok kasma yapıyor buna yapacak birşey varmı.

Kod: 
Sub suz_59()
'If ActiveSheet.Name = "2006" Then
    Dim i As Long, aaa, bbb, ccc, ddd, eee, fff As String
Set sr = Sheets("Data")
ListView1.ListItems.Clear
With ListView1
For i = 3 To sr.Cells(65536, "A").End(xlUp).Row
    If TextBox1.Value = "" Then
        aaa = sr.Cells(i, "A").Value
        Else
        aaa = TextBox1.Value
    End If
    If TextBox2.Value = "" Then
        bbb = sr.Cells(i, "B").Value
        Else
        bbb = TextBox2.Value
    End If
    If TextBox3.Value = "" Then
        ccc = sr.Cells(i, "C").Value
        Else
        ccc = TextBox3.Value
    End If
    If TextBox4.Value = "" Then
        ddd = sr.Cells(i, "D").Value
        Else
        ddd = TextBox4.Value
    End If
    If TextBox5.Value = "" Then
        eee = sr.Cells(i, "E").Value
        Else
        eee = TextBox5.Value
    End If
    If TextBox6.Value = "" Then
        fff = sr.Cells(i, "F").Value
        Else
        fff = TextBox6.Value
    End If
    aaa = UCase(Replace(Replace(aaa, "ı", "I"), "i", "İ"))
    bbb = UCase(Replace(Replace(bbb, "ı", "I"), "i", "İ"))
    ccc = UCase(Replace(Replace(ccc, "ı", "I"), "i", "İ"))
    ddd = UCase(Replace(Replace(ddd, "ı", "I"), "i", "İ"))
    eee = UCase(Replace(Replace(eee, "ı", "I"), "i", "İ"))
    fff = UCase(Replace(Replace(fff, "ı", "I"), "i", "İ"))

    If UCase(Replace(Replace(sr.Cells(i, "A").Value, "ı", "I"), "i", "İ")) _
    Like "*" & aaa & "*" _
    And UCase(Replace(Replace(sr.Cells(i, "B").Value, "ı", "I"), "i", "İ")) _
    Like "*" & bbb & "*" _
    And UCase(Replace(Replace(sr.Cells(i, "C").Value, "ı", "I"), "i", "İ")) _
    Like "*" & ccc & "*" _
    And UCase(Replace(Replace(sr.Cells(i, "D").Value, "ı", "I"), "i", "İ")) _
    Like "*" & ddd & "*" _
    And UCase(Replace(Replace(sr.Cells(i, "E").Value, "ı", "I"), "i", "İ")) _
    Like "*" & eee & "*" _
    And UCase(Replace(Replace(sr.Cells(i, "F").Value, "ı", "I"), "i", "İ")) _
    Like "*" & fff & "*" Then
            .ListItems.Add , , i
        X = X + 1
        .ListItems(X).ListSubItems.Add , , sr.Cells(i, "A")
        .ListItems(X).ListSubItems.Add , , sr.Cells(i, "B")
        .ListItems(X).ListSubItems.Add , , sr.Cells(i, "C")
        .ListItems(X).ListSubItems.Add , , sr.Cells(i, "D")
        .ListItems(X).ListSubItems.Add , , sr.Cells(i, "E")
        .ListItems(X).ListSubItems.Add , , sr.Cells(i, "F")
        .ListItems(X).ListSubItems.Add , , sr.Cells(i, "G")
        .ListItems(X).ListSubItems.Add , , sr.Cells(i, "H")
        .ListItems(X).ListSubItems.Add , , sr.Cells(i, "I")
        .ListItems(X).ListSubItems.Add , , sr.Cells(i, "J")
        .ListItems(X).ListSubItems.Add , , sr.Cells(i, "K")
        .ListItems(X).ListSubItems.Add , , sr.Cells(i, "L")
    End If    
Next i
End With
Set sr = Nothing
Exit Sub
    On Error Resume Next
    With Application
            .ScreenUpdating = False
            .EnableEvents = False
    End With
    Set sr = Sheets("Data")
    ListView1.ListItems.Clear
    ListView1.Sorted = False
    Set Alan = sr.Range("A3:A" & sr.[A65536].End(3).Row)
    Set Bul = Alan.Find(deg & "*")
        If Not Bul Is Nothing Then
                Adres = Bul.Address
             Do
                satır = Bul.Row
                With ListView1
                   .ListItems.Add , , sr.Cells(satır, "A")
                    X = X + 1
                     .ListItems(X).ListSubItems.Add , , sr.Cells(i, "A")
                     .ListItems(X).ListSubItems.Add , , sr.Cells(i, "B")
                     .ListItems(X).ListSubItems.Add , , sr.Cells(i, "C")
                     .ListItems(X).ListSubItems.Add , , sr.Cells(i, "D")
                     .ListItems(X).ListSubItems.Add , , sr.Cells(i, "E")
                     .ListItems(X).ListSubItems.Add , , sr.Cells(i, "F")
                     .ListItems(X).ListSubItems.Add , , sr.Cells(i, "G")
                     .ListItems(X).ListSubItems.Add , , sr.Cells(i, "H")
                     .ListItems(X).ListSubItems.Add , , sr.Cells(i, "I")
                     .ListItems(X).ListSubItems.Add , , sr.Cells(i, "J")
                     .ListItems(X).ListSubItems.Add , , sr.Cells(i, "K")
                     .ListItems(X).ListSubItems.Add , , sr.Cells(i, "L")
 
                End With
                Set Bul = Alan.FindNext(Bul)
             Loop While Not Bul Is Nothing And Bul.Address <> Adres
        ListView1.Sorted = True  'Sıralama işlemini açtık.
        ListView1.SortOrder = lvwAscending '(A dan Z ye küçükten büyüğe sıralı yap)
        ListView1.SortOrder = 0
        End If
    Set sr = Nothing
    Set Alan = Nothing
    Set Bul = Nothing
    With Application
            .EnableEvents = True
            .ScreenUpdating = True
    End With
End Sub
 
Orion1

Orion1

Uzman
Uzman
Katılım
1 Mart 2005
Mesajlar
22,248
Excel Vers. ve Dili
Win7 Home Basic TR 64 Bit

Ofis-2010-TR 32 Bit
50 binlik veride kasabilir.
listbox kullanısanız dizi yöntemi ile daha hızlı verileri alabilirisiniz.
 
Durum
Üzgünüz bu konu cevaplar için kapatılmıştır...
Üst