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 15-06-2017, 17:14   #1
mustilem23
Altın Üye
 
Giriş: 29/10/2010
Şehir: bursa
Mesaj: 265
Excel Vers. ve Dili:
office 2010
Varsayılan Belirli bir kurala göre parça alma

Merhaba
Ekte bulunan 2 tip durum için parça al fonksiyonu kullanarak macro ile yapılabileceğini düşündüğüm bir sorun var .

Satır ve sütunlar içinde belle bir kurala göre sayfaya aktarmak gibi yardımcı olabilir misiniz. Teşekkürler
Eklenmiş Dosyalar
Dosya Türü: xlsx ornek1.xlsx (9.6 KB, 8 Görüntülenme)
Dosya Türü: xlsx örnek2.xlsx (10.7 KB, 7 Görüntülenme)
mustilem23 Çevrimdışı   Alıntı Yaparak Cevapla
Eski 15-06-2017, 18:39   #2
asri
Altın Üye
 
Giriş: 24/04/2005
Şehir: Istanbul
Mesaj: 1,660
Excel Vers. ve Dili:
Office 2010 Tr
Varsayılan

Örnek 2 de,

Buradaki bilgiler ile aşağıdaki diğer bilgiler aynı yapıya sahip,

KLEMP SWICH TAKOZU (OTOMATIK KLEMP) 3509613220 2
klemp sviç yayı 3509612780 2
klemp sviç takoz civatası 3509612015 2

Siz sonuç sayfasında sadece alttaki yapıyı sonuca dahil etmişsiniz.

Program belli kriterlere göre çalışabilir, bu ayrımı neye göre yaptınız?

UST TARET TAKIMLARI GERI ITICI YAYI 3509611630 49
UST TARET D TAKIM KAMASI 3509611460 2
UST TARET C TAKIM KAMASI 3509611490 1
UST TARET INDEX C TAKIM KLAVUZLAMA KAMA 3509610920 1
UST TARET INDEX B TAKIM KLAVUZLAMA KAMA 3509610930 2
UST TARET A TAKIM KAMASI 3509611470 3
UST TARET B TAKIM KAMASI 3509611480 18
ALT TARET C INDEX TAKIM KLAVUZLAMA KAMA 3509611200 1
ALT TARET 201 216 NO TAKIM KLAVUZ KAMASI 3509610220 2


Ayrıca örnek 1 de ve örnek 2 aşağıdaki yapıda satırlar mevcut.
2 AD 3509611905
2 AD 3509611915
4 AD 3509611920
2 AD 3304300130

Örnek 1 de sonuç kısmına bunu dahil etmişsiniz. Ancak Örnek 2 de dahil etmemişsiniz.
Dahil edip etmeme kuralı nedir?
__________________
www.asriakdeniz.com
asri Çevrimdışı   Alıntı Yaparak Cevapla
Eski 15-06-2017, 19:18   #3
mustilem23
Altın Üye
 
Giriş: 29/10/2010
Şehir: bursa
Mesaj: 265
Excel Vers. ve Dili:
office 2010
Varsayılan

Üstadım buradaki durum hep aynı bu veriler outlook içinden kopyaladım verilerin bazıları satır ve sütun olarak geliyor ama onlarında malzeme no tanım adet şeklinde çeviriyorum bazılarına düz metin olarak envanter no ve adet olarak geliyor email de sonuçta ise bana gerekli olan envanter no ve adet yani üstad 2 koşul mevcut .olabilmesi mümkün müdür.
mustilem23 Çevrimdışı   Alıntı Yaparak Cevapla
Eski 15-06-2017, 20:32   #4
asri
Altın Üye
 
Giriş: 24/04/2005
Şehir: Istanbul
Mesaj: 1,660
Excel Vers. ve Dili:
Office 2010 Tr
Varsayılan

Alıntı:
mustilem23 tarafından gönderildi Mesajı Görüntüle
Üstadım buradaki durum hep aynı bu veriler outlook içinden kopyaladım verilerin bazıları satır ve sütun olarak geliyor ama onlarında malzeme no tanım adet şeklinde çeviriyorum bazılarına düz metin olarak envanter no ve adet olarak geliyor email de sonuçta ise bana gerekli olan envanter no ve adet yani üstad 2 koşul mevcut .olabilmesi mümkün müdür.
Burada sorun ayırmak değil, belli bir koşula göre sonuç çıkarmak.

Soru şu şekilde olur ise çözüm olabilir.
Tüm envanter no ve adetleri listeleyebilir miyiz?
__________________
www.asriakdeniz.com
asri Çevrimdışı   Alıntı Yaparak Cevapla
Eski 15-06-2017, 20:45   #5
mustilem23
Altın Üye
 
Giriş: 29/10/2010
Şehir: bursa
Mesaj: 265
Excel Vers. ve Dili:
office 2010
Varsayılan

Haklısınız üstad. Evet tam olarak ihtiyacım budur.böyle birşey mümkünmüdür.
mustilem23 Çevrimdışı   Alıntı Yaparak Cevapla
Eski 15-06-2017, 21:35   #6
asri
Altın Üye
 
Giriş: 24/04/2005
Şehir: Istanbul
Mesaj: 1,660
Excel Vers. ve Dili:
Office 2010 Tr
Varsayılan

Text dosyadan okunacak şekilde deneyiniz.

Örnek veri dosyası ve dosya ektedir.

Kod: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
Public veriler(1000000, 3) As String
Dim txtdosya, verisay As Long
Dim readdata, yontem, readdataorg, veri As String
Dim satir As Long

Function dosyavarmi(dosya)
  Dim ds, a
  Set ds = CreateObject("Scripting.FileSystemObject")
  a = ds.FileExists(dosya)
  If a = True Then
    dosyavarmi = True
  Else
    dosyavarmi = False
  End If
End Function

Sub menu()
   ChDir ActiveWorkbook.Path
   txtdosya = Application.GetOpenFilename(("Text Dosyalar (*.txt), *.txt"), 1, "Text Dosya Seçiniz")

   If txtdosya = "" Then
       MsgBox ("İşlem iptal edildi.")
      Exit Sub
   End If
   
   Call temizle
   Call sifirla
   Call veri_temizle_dosyadan
   Call bilgi_al
End Sub

Sub sifirla()
  For i = 1 To 1000000
     veriler(verisay, 1) = ""
     veriler(verisay, 2) = ""
     veriler(verisay, 3) = ""
  Next i
End Sub

Sub veri_temizle_dosyadan()
  Set shmenu = Sheets("Menu")
  yol = ThisWorkbook.Path
  
  Dim readdata As String
    verisay = 0
    Open txtdosya For Input As #1
      Do Until EOF(1)
         verial = True
         Line Input #1, readdata
         readdata = Trim(readdata)
         readdata = Replace(readdata, Chr(9), " ")
         veri = Trim(readdata)
         veri = UCase(veri)
         
         If sadececizgimi(veri) Then
            verial = False
            GoTo son
         End If
         
         If Len(veri) <= 2 Then
            verial = False
            GoTo son
         End If

son:
         If verial Then
            verisay = verisay + 1
            veriler(verisay, 1) = tek_bosluk(readdata)
         End If
      Loop
    Close #1

 End Sub
 
Sub temizle()
    Sheets("Liste").Select
    Columns("A:I").Select
    With Selection.Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Range("A1").Select
    Sheets("Menu").Select
End Sub

Sub bilgi_al()
  Application.ScreenUpdating = False
    Set shliste = Sheets("Liste")
    Set shmenu = Sheets("MENU")
    
    Sheets("Liste").Select
    Range("F1").Select
    
    yol = ThisWorkbook.Path
    Dim readdata As String

    'listesatir = shliste.Cells(Rows.Count, "A").End(3).Row
    listesatir = 1
   
    For i = 1 To verisay
         verial = False
         readdata = veriler(i, 1)
         readdataorg = readdata
         readdata = tek_bosluk(Replace(readdata, Chr(9), " "))
         readdata = Trim(readdata)
         
         adet = ""
         birim = ""
         aciklama = ""
         kod = ""
         
         veri = UCase(readdata)
         sayii = InStrRev(veri, " ")
         sayi = Mid(veri, sayii + 1, Len(veri))
         
         If sayimi(sayi) And Len(sayi) < 10 And InStr(veri, " ") >= 2 Then
            adet = sayi
            gecici = Mid(veri, 1, sayii - 1)
            sayii = InStrRev(gecici, " ")
            sayi = Mid(gecici, sayii + 1, Len(veri))
            
            If sayimi(sayi) And Len(sayi) >= 10 Then
               kod = sayi
               aciklama = Mid(veri, 1, sayii - 1)
            End If
            
            If sayimi(sayi) = False And Len(sayi) <= 2 Then
               kod = sayi
               aciklama = Mid(veri, 1, sayii - 1)
            End If
         End If
         
         If sayimi(sayi) And Len(sayi) >= 10 And InStr(veri, " ") >= 2 Then
            kod = sayi
            gecici = Mid(veri, 1, sayii - 1)
            sayii = InStrRev(gecici, " ")
            sayi = Mid(gecici, sayii + 1, Len(veri))
            If sayimi(sayi) = False And Len(sayi) <= 3 Then
               birim = sayi
               adet = Mid(veri, 1, sayii - 1)
            End If
         End If
         
         If kod <> "" And adet <> "" Then
            listesatir = listesatir + 1
            shliste.Cells(listesatir, 1).Value = kod
            shliste.Cells(listesatir, 2).Value = aciklama
            shliste.Cells(listesatir, 3).Value = birim
            shliste.Cells(listesatir, 4).Value = adet
         End If
  
enson:
  Next i
End Sub

Function sadececizgimi(sadecesayistr)
  liste = "+=-_ /" & sayikabuletstr
  For k = 1 To Len(sadecesayistr)
    harf = Mid(sadecesayistr, k, 1)
    If InStr(liste, harf) <= 0 Then
       sadececizgimi = False
       Exit Function
    End If
  Next k
  sadececizgimi = True
End Function

Public Function tek_bosluk(cumle)
  gecici = ""
  eski = "99"
  If InStr(1, cumle, " ") > 0 Then
    For i2 = 1 To Len(cumle)
      h = Mid(cumle, i2, 1)
      If eski <> " " Then
        gecici = gecici + h
      ElseIf eski = " " And h <> " " Then
        gecici = gecici + h
      End If
      eski = h
    Next i2
    tek_bosluk = gecici
  Else
    tek_bosluk = cumle
  End If

End Function

Function sayimi(sadecesayistr)
  liste = "0123456789"
  For k = 1 To Len(sadecesayistr)
    harf = Mid(sadecesayistr, k, 1)
    If InStr(liste, harf) = 0 Then
       sayimi = False
       Exit Function
    End If
  Next k
  sayimi = True
End Function
Eklenmiş Dosyalar
Dosya Türü: xlsm Servis Teklif Dosyadan.xlsm (39.7 KB, 8 Görüntülenme)
Dosya Türü: txt veri.txt (2.0 KB, 11 Görüntülenme)
__________________
www.asriakdeniz.com
asri Çevrimdışı   Alıntı Yaparak Cevapla
Eski 16-06-2017, 19:09   #7
mustilem23
Altın Üye
 
Giriş: 29/10/2010
Şehir: bursa
Mesaj: 265
Excel Vers. ve Dili:
office 2010
Varsayılan

Oncelik ile Üstad emeğin için teşekkür ederim.hayırlı ramazanlar. Bugün işler epey yoğundu birkaç deneme yaptım süper. 😎
Lakin asıl hedefime tam ulaşamadım aktarılan exceli autoit ile beraber çalıştırdım ama sheet ayarında ve hücrelerinden sıkıntıdan kaynaklı ilerleme yapamadım rica etsem autoit çalışma scriptime bir göz atabilirmisiniz teklif.xls iptal yerine servıs dosyası .xls 2. sayfa satır ve sütunları .yardımlarınız için şimdiden çok teşekkür ederim.

http://www.dosyaupload.com/dcXx

Çok hoş bir uygulama olacak benim için.
mustilem23 Çevrimdışı   Alıntı Yaparak Cevapla
Eski 17-06-2017, 11:31   #8
asri
Altın Üye
 
Giriş: 24/04/2005
Şehir: Istanbul
Mesaj: 1,660
Excel Vers. ve Dili:
Office 2010 Tr
Varsayılan

Alıntı:
mustilem23 tarafından gönderildi Mesajı Görüntüle
.. autoit çalışma scriptime bir göz atabilirmisiniz teklif.xls iptal yerine servıs dosyası .xls 2. sayfa satır ve sütunları ..
yazdığınızdan hiç birşey anlamadım.

Bu kodların altına
Local $stok=$oExcel.activesheet.cells($i, 1).value
Local $adet=$oExcel.activesheet.cells($i, 3).value

bunu eklediğimde excel den okuma yaptığını görebiliyoruz.
MsgBox($MB_SYSTEMMODAL, "Okunan bilgi", "Stok : " & $stok & " adet : " & $adet )
exit

Bunu da kodun en başına ekleyin.
#include <MsgBoxConstants.au3>
__________________
www.asriakdeniz.com
asri Çevrimdışı   Alıntı Yaparak Cevapla
Eski 19-06-2017, 16:39   #9
mustilem23
Altın Üye
 
Giriş: 29/10/2010
Şehir: bursa
Mesaj: 265
Excel Vers. ve Dili:
office 2010
Varsayılan

Burayı denedim yazmadan önce fakat servıs dosyasından adlı excelw actirabildim fakat liste sayfasını actira madım liste sayfasinda n okuma yaptırabilirmiyiz .kodlar şuan aktif olan ilk menü sayfasını okuyabiliyor yardımcı olabilirmisiniz rica etsem.
mustilem23 Çevrimdışı   Alıntı Yaparak Cevapla
Eski 19-06-2017, 16:42   #10
asri
Altın Üye
 
Giriş: 24/04/2005
Şehir: Istanbul
Mesaj: 1,660
Excel Vers. ve Dili:
Office 2010 Tr
Varsayılan

Alıntı:
mustilem23 tarafından gönderildi Mesajı Görüntüle
Burayı denedim yazmadan önce fakat servıs dosyasından adlı excelw actirabildim fakat liste sayfasını actira madım liste sayfasinda n okuma yaptırabilirmiyiz .kodlar şuan aktif olan ilk menü sayfasını okuyabiliyor yardımcı olabilirmisiniz rica etsem.
Buradaki (1) değerini 2 yada 3 yazarak deneyin.

$oExcel.Workbooks.Open (@ScriptDir & "\teklif.xlsx").Sheets (1).Select ()
__________________
www.asriakdeniz.com
asri Ç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 22:33


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

Excel Eğitimi - Mobil Uygulama - Çorlu - Çorlu Hurda - Torna - Çorlu Web Tasarım - Tarot Falı - Fenerbahçe Haberleri - Trakya Haberleri - invest in turkey - Hurda - Tekirdağ Samsung - Kozmetik Ürünler - Sağlıklı Makyaj Ürünleri - Yaşlanma Karşıtı Ürünler - Excel Eğitimi - Çorlu osgb - Lingerie - Dyeing Machine - Çorlu Temizlik- Hazır Site- SEO- Çorlu Burun Estetiği- Çorlu Pimapen- Karton Bardak- Marka Tescil Danışmanlık- Marmara Ereğlisi Restaurant- Çorlu Baskı- Çorlu Sigorta- Çorlu Pimapenci- İstanbul Avukat- Çorlu Sürücü Kursu- Çorlu Rehabilitasyon- Edirne Su Arıtma-
Powered by vBulletin Version 3.7.2
Copyright ©2000 - 2017, Jelsoft Enterprises Ltd.
Advertisement System V2.6 By   Branden