• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

TextBoxta girilen değere göre toplama işlemi

  • Konbuyu başlatan Konbuyu başlatan Mx@Raid
  • Başlangıç tarihi Başlangıç tarihi
M

Mx@Raid

Katılım
7 Ağustos 2007
Mesajlar
328
Excel Vers. ve Dili
excell 2003 - 2007
Arkadaşlar aşağıdaki kod ile toplama işlemi yapabiliyor, ancak Harf aratarak yapılan süzmede sorun olmuyor. kelime olarak aradığımda liste süzülerek verilmiyor.

Kod: 
Private Sub TextBox1_Change()

BUL

    [COLOR="Red"]TextBox6.Text = Format(WorksheetFunction.Sum(Range("F2:F" & Cells(65536, "F") _
    .End(xlUp).Row).SpecialCells(xlCellTypeVisible)), "#,##0.00")

    TextBox7.Text = Format(WorksheetFunction.Sum(Range("G2:G" & Cells(65536, "G") _
    .End(xlUp).Row).SpecialCells(xlCellTypeVisible)), "#,##0.00")[/COLOR] (bu alanın işlemini Evren hocam hazırlamıştı sağolsun)

    If TextBox1.Text = Empty Then
    
        Rows("1:1000").EntireRow.Hidden = False
        
            TextBox6.Text = Clear
            TextBox7.Text = Clear
                    
End If

End Sub

Bulma yöntemi de aşağıdaki gibi. Ancak toplama işleminin yapıldığı makroyu çıkardığımda normal şekilde süzme yapıyor.

Kod: 
Private Sub BUL()
Application.ScreenUpdating = False

yer = ActiveSheet.Name
Set sh = Sheets(yer)

Rows("1:1000").EntireRow.Hidden = False

aranan2 = ""
If sh.TextBox1.Text <> "" Then
aranan2 = aranan2 & sh.TextBox1.Text
End If
If sh.TextBox2.Text <> "" Then
aranan2 = aranan2 & sh.TextBox2.Text
End If
If sh.TextBox3.Text <> "" Then
aranan2 = aranan2 & sh.TextBox3.Text
End If
If sh.TextBox4.Text <> "" Then
aranan2 = aranan2 & sh.TextBox4.Text
End If
If sh.TextBox5.Text <> "" Then
aranan2 = aranan2 & sh.TextBox5.Text
End If
If sh.TextBox6.Text <> "" Then
aranan2 = aranan2 & sh.TextBox6.Text
End If
If sh.TextBox7.Text <> "" Then
aranan2 = aranan2 & sh.TextBox7.Text
End If
If sh.TextBox8.Text <> "" Then
aranan2 = aranan2 & sh.TextBox8.Text
End If


For i = 2 To [a65536].End(3).Row + 1
aranan1 = ""

If sh.OptionButton1.Value = True Then
If sh.TextBox1.Text <> "" Then
aranan1 = aranan1 & Mid(sh.Cells(i, 1).Value, 1, Len(sh.TextBox1.Text))
End If
If sh.TextBox2.Text <> "" Then
aranan1 = aranan1 & Mid(sh.Cells(i, 2).Value, 1, Len(sh.TextBox2.Text))
End If
If sh.TextBox3.Text <> "" Then
aranan1 = aranan1 & Mid(sh.Cells(i, 3).Value, 1, Len(sh.TextBox3.Text))
End If
If sh.TextBox4.Text <> "" Then
aranan1 = aranan1 & Mid(sh.Cells(i, 4).Value, 1, Len(sh.TextBox4.Text))
End If
If sh.TextBox5.Text <> "" Then
aranan1 = aranan1 & Mid(sh.Cells(i, 5).Value, 1, Len(sh.TextBox5.Text))
End If
If sh.TextBox6.Text <> "" Then
aranan1 = aranan1 & Mid(sh.Cells(i, 6).Value, 1, Len(sh.TextBox6.Text))
End If
If sh.TextBox7.Text <> "" Then
aranan1 = aranan1 & Mid(sh.Cells(i, 7).Value, 1, Len(sh.TextBox7.Text))
End If
If sh.TextBox8.Text <> "" Then
aranan1 = aranan1 & Mid(sh.Cells(i, 8).Value, 1, Len(sh.TextBox8.Text))
End If

End If


If sh.OptionButton2.Value = True Then

If sh.TextBox1.Text <> "" Then
aranan1 = aranan1 & sh.Cells(i, 1).Value
End If
If sh.TextBox2.Text <> "" Then
aranan1 = aranan1 & sh.Cells(i, 2).Value
End If
If sh.TextBox3.Text <> "" Then
aranan1 = aranan1 & sh.Cells(i, 3).Value
End If
If sh.TextBox4.Text <> "" Then
aranan1 = aranan1 & sh.Cells(i, 4).Value
End If
If sh.TextBox5.Text <> "" Then
aranan1 = aranan1 & sh.Cells(i, 5).Value
End If
If sh.TextBox6.Text <> "" Then
aranan1 = aranan1 & sh.Cells(i, 6).Value
End If
If sh.TextBox7.Text <> "" Then
aranan1 = aranan1 & sh.Cells(i, 7).Value
End If
If sh.TextBox8.Text <> "" Then
aranan1 = aranan1 & sh.Cells(i, 8).Value
End If

End If

aranan1 = UCase(Replace(Replace(aranan1, "I", "İ"), "i", "I"))
aranan2 = UCase(Replace(Replace(aranan2, "I", "İ"), "i", "I"))

If aranan1 <> aranan2 Then
Rows(i).EntireRow.Hidden = True
End If

Next

Application.ScreenUpdating = True

End Sub
 
bunu denermisiniz.

Private Sub TextBox1_Change()
BUL
TextBox6.Text = Format(WorksheetFunction.Sum(Range("F2:F" & Cells(65536, "F") _
.End(xlUp).Row).SpecialCells(xlCellTypeVisible)), "#,##0.00")
TextBox7.Text = Format(WorksheetFunction.Sum(Range("G2:G" & Cells(65536, "G") _
.End(xlUp).Row).SpecialCells(xlCellTypeVisible)), "#,##0.00")
If TextBox1.Text = "" Then
Rows("1:1000").EntireRow.Hidden = False
TextBox6.Text = Clear
TextBox7.Text = Clear
End If
End Sub
Genişletmek için tıkla ...

birde OptionButton seçenek düğmeleri yapacağın işe göre tikli olması lazım.
 
Halit hocam maalesef olmadı OptionButton Seçiliyken yapıyorum.

TextBox6.Text = Format(WorksheetFunction.Sum(Range("F2:F" & Cells(65536, "F") _
.End(xlUp).Row).SpecialCells(xlCellTypeVisible)), "#,##0.00")
TextBox7.Text = Format(WorksheetFunction.Sum(Range("G2:G" & Cells(65536, "G") _
.End(xlUp).Row).SpecialCells(xlCellTypeVisible)), "#,##0.00")

buradaki toplama işlemi pasifken listeyi kelimeye göre listeyi veriyor. Aktifleştirdiğimde çalışmıyor.
 
örnek dosyanı gönder bakalım
 
burada TextBox6.Text ve TextBox7.Text nesnesinin Change olayındaki bul makrolarını silmelisiniz. burada döngü oluyor toplanan değerde veri arıyor.
 
Halit hocam dosyayı ekledim. Forumda bir sıkıntı var galiba, düzelmesini bekledim.
 

Ekli dosyalar

bunları
TextBox6.Text = Clear
TextBox7.Text = Clear
Genişletmek için tıkla ...
bul makrosunun üstüne koy

yani öncelik le textboxları temizlesin

Private Sub TextBox1_Change()
TextBox6.Text = Clear
TextBox7.Text = Clear
BUL
TextBox6.Text = Format(WorksheetFunction.Sum(Range("F2:F" & Cells(65536, "F") _
.End(xlUp).Row).SpecialCells(xlCellTypeVisible)), "#,##0.00")

TextBox7.Text = Format(WorksheetFunction.Sum(Range("G2:G" & Cells(65536, "G") _
.End(xlUp).Row).SpecialCells(xlCellTypeVisible)), "#,##0.00")
If TextBox1.Text = "" Then

Rows("1:1000").EntireRow.Hidden = False
TextBox6.Text = Clear
TextBox7.Text = Clear



End If
End Sub
Genişletmek için tıkla ...
 
Sn. Halit hocam teşekkürler. Emeğinize yüreğinize sağlık.
 
Bul makrosunu ve toplama durumunu farklı olarak yaptım. Bir incele textbox6 ve textbox7 nesneleride süzüyor toplamları hücreye topluyor

bu dururmda bul makrosunu değiştirmeden istediğiniz kadar textbox nesnesi ekleyebilirsiniz.
 

Ekli dosyalar

Arkadaslar ellerinize saglık. super bir calışma olmus. gunlerdir bu dosya uzerinde ugrasıyordum. çok teşekkürler. iyi çalışmalar hepinize.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst