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: 280
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, 9 Görüntülenme)
Dosya Türü: xlsx örnek2.xlsx (10.7 KB, 11 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: 2,272
Excel Vers. ve Dili:
Office 2016 TR 64 Bit
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: 280
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: 2,272
Excel Vers. ve Dili:
Office 2016 TR 64 Bit
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: 280
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: 2,272
Excel Vers. ve Dili:
Office 2016 TR 64 Bit
Varsayılan

Text dosyadan okunacak şekilde deneyiniz.

Örnek veri dosyası ve dosya ektedir.
Bu verileri
1ad3507005011
2 ad 3507005012
3AD 3507005013
ad zımba 4 3507005014
ZIMBA 3507005015 5
6 ADET 3507005016
3507005017 ZIMBA ADET 7
AD8 3507005018
ad 3507005019 9
adet 3507005020 10
ADET 3507005021 11
3507005022 ZIMBA ADET 12
ZIMBA 3507005023 13
14 3507005024 ADET
AD 3507005025 14
ad zımba 15 3507005026
3507005027 16
17 3507005028
3507005029 ZIMBA ADET 18
3507005030 ZIMBA ADET 19


Bu şekilde listeleyecektir
Kod Adet
3507005011 1
3507005012 2
3507005013 3
3507005014 4
3507005015 5
3507005016 6
3507005017 7
3507005018 8
3507005019 9
3507005020 10
3507005021 11
3507005022 12
3507005023 13
3507005024 14
3507005025 14
3507005026 15
3507005027 16
3507005028 17
3507005029 18
3507005030 19

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)
         
         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
    sonsatir = Cells(Rows.Count, "A").End(3).Row
    Range("A2:I" & sonsatir).Clear
    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
         readdata = veriler(i, 1)
         readdataorg = readdata
         readdata = kelimeayir(readdata)
         readdata = sayiayir(readdata)
         readdata = Trim(tek_bosluk(readdata))
         adet = ""
         kod = ""
         veri = readdata
         sayi1 = Mid(veri, 1, InStr(veri, " ") - 1)
         sayi2 = Mid(veri, InStr(veri, " ") + 1, Len(veri))
         kod = ""
         adet = ""
         If Len(sayi1) > Len(sayi2) Then
            kod = sayi1
            adet = sayi2
         End If
         
         If Len(sayi2) > Len(sayi1) Then
            kod = sayi2
            adet = sayi1
         End If
  
         If kod <> "" And adet <> "" Then
            listesatir = listesatir + 1
            shliste.Cells(listesatir, 1).Value = kod
            shliste.Cells(listesatir, 2).Value = adet
         End If
  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 kelimeayir(veristr) As String
  liste = "0123456789"
      yenistr = ""
      For k = 1 To Len(veristr)
        h = Mid(veristr, k, 1)
        durum = "x"
        If InStr(liste, h) > 0 Then durum = "s"
        If InStr(liste, h) = 0 Then durum = "h"
        If k = 1 Then oncekidurum = durum
        
        If durum = oncekidurum Then
           yenistr = yenistr & h
        Else
           yenistr = yenistr & " " & h
        End If
        oncekidurum = durum
      Next k
      kelimeayir = yenistr
End Function


Function sayiayir(veristr) As String
  liste = "0123456789"
  yenistr = ""
  For k = 1 To Len(veristr)
    h = Mid(veristr, k, 1)
    If InStr(liste, h) > 0 Or h = " " Then
       yenistr = yenistr & h
    End If
  Next k
  sayiayir = yenistr
End Function
Eklenmiş Dosyalar
Dosya Türü: xlsm Servis Teklif Dosyadan.xlsm (32.2 KB, 4 Görüntülenme)
Dosya Türü: txt veri.txt (466 Byte, 3 Görüntülenme)
__________________
www.asriakdeniz.com

Bu mesaj en son " 23-06-2017 " tarihinde saat 20:48 itibariyle asri tarafından düzenlenmiştir....
asri Çevrimdışı   Alıntı Yaparak Cevapla
Eski 16-06-2017, 19:09   #7
mustilem23
Altın Üye
 
Giriş: 29/10/2010
Şehir: bursa
Mesaj: 280
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: 2,272
Excel Vers. ve Dili:
Office 2016 TR 64 Bit
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: 280
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: 2,272
Excel Vers. ve Dili:
Office 2016 TR 64 Bit
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 13:19


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

Excel Eğitimi - Mobil Uygulama - Çorlu - Torna - Çorlu Web Tasarım - Tarot Falı - invest in turkey - Lingerie - Dyeing Machine - Çorlu Temizlik- 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- Su Deposu Temizliği- Bakır Sülfat- Rampa- Rotary- Çorlu İnternet Sitesi-
Powered by vBulletin Version 3.7.2
Copyright ©2000 - 2017, Jelsoft Enterprises Ltd.
Advertisement System V2.6 By   Branden