Excel Forum
ALTIN ÜYELİK Hakkında Bilgi


Geri Git   Excel Forum > EXCEL-Soruları > Makro-VBA
Atatürk
Şifremi Unuttum

DUYURU SİSTEMİ / REKLAM PANOSU

Makro-VBA Makro veya VBA ile ilgili sorularınızı buraya gönderebilirsiniz.
Dosya ekleyebilirsiniz

Özel Arama


Yanıtla
 
Paylaş Konu Araçları Görünüm Modları
Eski 03-11-2017, 22:47   #1
ADER_34
 
Giriş: 02/06/2015
Şehir: İstanbul
Mesaj: 228
Excel Vers. ve Dili:
2010
Varsayılan Texboxta içeren süzme

Merhaba arkadaşlar kullandığım kodlarda texbox kutusuna örnek" BAD" yazdığımda
BAD içeren kelimer geliyor yani SCRAP_BAD BAD_RTV gibi

ben sadece BAD içeren gelmesi için kodda nasıl bir düzeltme yapmam gerekiyor kodlar

Sub Sonuçgetir()
Dim sh As Worksheet, sonsat As Long
Sheets("STOK_AKTAR").Select
Range("A3:M" & Rows.Count).ClearContents
Set sh = Sheets("SİSTEM_STOK")
sonsat = sh.Cells(Rows.Count, "A").End(xlUp).Row
Application.ScreenUpdating = False
sh.Range("A1").AutoFilter
If TextBox1.Value <> "" Then
sh.Range("A1").AutoFilter field:=1, Criteria1:="*" & Sheets("STOK_AKTAR").TextBox1.Value & "*"
End If
If TextBox2.Value <> "" Then
sh.Range("A1").AutoFilter field:=2, Criteria1:="*" & Sheets("STOK_AKTAR").TextBox2.Value & "*"
End If
If TextBox3.Value <> "" Then
sh.Range("A1").AutoFilter field:=12, Criteria1:="*" & Sheets("STOK_AKTAR").TextBox3.Value & "*"
End If
If TextBox4.Value <> "" Then
sh.Range("A1").AutoFilter field:=6, Criteria1:="*" & Sheets("STOK_AKTAR").TextBox4.Value & "*"
End If
If TextBox5.Value <> "" Then
sh.Range("A1").AutoFilter field:=5, Criteria1:="*" & Sheets("STOK_AKTAR").TextBox5.Value & "*"
End If
If TextBox6.Value <> "" Then
sh.Range("A1").AutoFilter field:=4, Criteria1:="*" & Sheets("STOK_AKTAR").TextBox6.Value & "*"
End If
sh.Range("A1:E" & sonsat).CurrentRegion.Offset(1, 0).Copy Range("A3")
sh.Range("A1").AutoFilter


End Sub
ADER_34 Çevrimdışı   Alıntı Yaparak Cevapla
Eski 04-11-2017, 09:18   #2
askm
Altın Üye
 
Giriş: 04/06/2005
Şehir: k.maraş
Mesaj: 1,627
Excel Vers. ve Dili:
2010-2016
Varsayılan

Örnek dosya eklerseniz sorun nerde daha iyi çözülür.
__________________
excel 2010- türkçe
askm Çevrimdışı   Alıntı Yaparak Cevapla
Eski 04-11-2017, 19:16   #3
ADER_34
 
Giriş: 02/06/2015
Şehir: İstanbul
Mesaj: 228
Excel Vers. ve Dili:
2010
Varsayılan

Merhaba sayın askım örnek dosya ekliyorum bakabilirmisiniz? teşekkürler

http://s4.dosya.tc/server5/8wubey/SUZ_GETIR.rar.html
ADER_34 Çevrimdışı   Alıntı Yaparak Cevapla
Eski 04-11-2017, 20:18   #4
askm
Altın Üye
 
Giriş: 04/06/2005
Şehir: k.maraş
Mesaj: 1,627
Excel Vers. ve Dili:
2010-2016
Varsayılan

Direkt textboxa çift tıklayıp aşağıdaki kodları ekleyin.
Kod: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
Private Sub TextBox1_Change()
Dim sh As Worksheet, sonsat As Long
Set sh = Sheets("SİSTEM_STOK")
sonsat = sh.Cells(Rows.Count, "A").End(xlUp).Row
Range("A3:M" & Rows.Count).ClearContents
Dim METİN1 As String, FC2 As Range
On Error Resume Next
METİN1 = TextBox1.Value
Set FC2 = sh.Range("a1:e65000").Find(What:=METİN1)
sh.Range("a1:e65000").AutoFilter Field:=1, Criteria1:="*" & TextBox1.Value & "*"
sh.Range("A1:E" & sonsat).CurrentRegion.Offset(1, 0).Copy Range("A3")
If METİN1 = "" Then
sh.Range("a1:e65000").AutoFilter Field:=3
Range("A3:M" & Rows.Count).ClearContents
End If
End Sub
__________________
excel 2010- türkçe
askm Çevrimdışı   Alıntı Yaparak Cevapla
Eski 04-11-2017, 22:02   #5
ADER_34
 
Giriş: 02/06/2015
Şehir: İstanbul
Mesaj: 228
Excel Vers. ve Dili:
2010
Varsayılan

Merhaba sayın askım benim amacım bu değil ilk mesajımı okursanız texbox kutusuna yazdığım kelime tam eşleşme ile aktarılsın istiyorum bu kodlar içene kelimeleri aktarıyor
ADER_34 Çevrimdışı   Alıntı Yaparak Cevapla
Eski 05-11-2017, 00:32   #6
Ziynettin
Altın Üye
 
Giriş: 17/04/2008
Şehir: istanbul
Mesaj: 399
Excel Vers. ve Dili:
office2010
Varsayılan

...

Bu şekilde deneyiniz.

Kod: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
Sub aktar()
Dim s1 As Worksheet, s2 As Worksheet
Dim a(), aranan As String
Dim i As Long, say As Long, son As Long, j As Long
Set s1 = Sheets("Sayfa1")
Set s2 = Sheets("Sayfa2")
son = s1.Range("A" & Rows.Count).End(3).Row
a = s1.Range("A2:E" & son)
aranan = Sheets("Sayfa2").TextBox1.Text
For i = 1 To UBound(a)
    If aranan = a(i, 1) Then
        say = say + 1
        For j = 1 To UBound(a, 2)
            a(say, j) = a(i, j)
        Next j
    End If
Next i
s2.Range("A3:E" & Rows.Count).ClearContents
If say > 0 Then
    s2.[A3].Resize(say, UBound(a, 2)) = a
End If
MsgBox "Aktarma işlemi tamam..", vbInformation
End Sub
Ziynettin Çevrimdışı   Alıntı Yaparak Cevapla
Eski 05-11-2017, 08:42   #7
askm
Altın Üye
 
Giriş: 04/06/2005
Şehir: k.maraş
Mesaj: 1,627
Excel Vers. ve Dili:
2010-2016
Varsayılan

Başında ve sonunda olan yıldızı silin.
__________________
excel 2010- türkçe
askm Çevrimdışı   Alıntı Yaparak Cevapla
Eski 05-11-2017, 10:45   #8
ADER_34
 
Giriş: 02/06/2015
Şehir: İstanbul
Mesaj: 228
Excel Vers. ve Dili:
2010
Varsayılan

Merhaba sayın Ziynettin kodlarınız sorunsuz çalışıyor,kendi dosyama uyarladım sizden bir isteğim daha olacak kendi dosyamı örnek olarak siteye yüklüyorum ürünleri Süzerken 3 tane Texbox olarak süzmek istiyorum değer RTV_TRANSFER sayfasına "Q R S T" sütunlarındaki değerlere bakarak süzmek istiyorum mümkünmü? kolaygelsin teşekkürler
http://s5.dosya.tc/server5/644oh0/RT...GETIR.rar.html
ADER_34 Çevrimdışı   Alıntı Yaparak Cevapla
Yanıtla


Konu Araçları
Görünüm Modları

Gönderme Kuralları
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts

BB code is Açık
SimgelerAçık
[IMG] kodu Açık
HTML kodu Kapalı


Saat 02:05


Bu forum Elit NET - www.elitnet.com.tr tarafından sunulmaktadır.

Excel Eğitimi - Mobil Uygulama - Çorlu - Çorlu Web Tasarım - Tarot Falı - invest in turkey - Lingerie - Dyeing Machine - Karton Bardak- Çorlu Özel Eğitim- Site Yönetimi- Led Aydınlatma- Pronet Tekirdağ- Çorlu Kamera- Pronet Edirne- Pronet Kırklareli- Pronet Çerkezköy- Pronet Çorlu- Pronet Lüleburgaz- Pronet Keşan- Çorlu Araç Takip- Çorlu Su Arıtma- Boru Profil- Gebze Emlak- Beylikdüzü Temizlik- İstanbul Burun Estetiği- Bakır Sülfat- Rampa- Rotary- Çorlu İnternet Sitesi- youngblood- Çorlu Palet- Çerkezköy Palet- Çorlu Prefabrik- Çorlu Sürücü Kursu- Çorlu Sandviç Panel- Şişli Avukat- Korona Test Kalemi- Çorlu Vinç- Çorlu Pimapen Tamiri- Çorlu Çelik Konstruksiyon-
Powered by vBulletin Version 3.7.2
Copyright ©2000 - 2017, Jelsoft Enterprises Ltd.
Advertisement System V2.6 By   Branden