Inputbox ile İki Kriterli Veri Oluşturma,

M

MrExcelMr

Katılım
2 Eylül 2019
Mesajlar
130
Excel Vers. ve Dili
2010-2013-2017 Eng.
Merhaba;

Resimde paylaştığım şekilde verilerim bulunmaktadır. Günlük olarak veri bilgileri eklenmektedir. Sayfa1 de yer alan A sütunundaki Bölge ve F sütunundaki Arıza Tarihi bilgileri Inputbox seçeneği ile belirtip o bölgeye ait ve o tarihe ait verileri başlıklar ile birlikte yeni bir excel dosyası oluşturmasını istiyorum. (Örnek: ANKARA Xlsm.)Böyle bir işlem yapılabilir mi.

Oluşturulacak dosyanın yolu: Masaüstü/Bölge Araç Servis Takibi
Inputbox ile Bölgesi belirtilen ancak Arıza tarihi girilmemesi durumunda o bölgeye ait tüm verilerin aktarılmasını istiyorum. Konu hakkında yardımlarınızı talep ediyorum. Teşekkürler.


 
M

MrExcelMr

Katılım
2 Eylül 2019
Mesajlar
130
Excel Vers. ve Dili
2010-2013-2017 Eng.
sN. @leguminosea Çok teşekkür ederim. Çok kapsamlı bir çalışma olmuş. Tek sayfa üzerinden bu çalışmanın yapılma şansı yok mu? Kitabın içerisindeki sayfalarda farklı işlemler yapılıyor. "L" sütunun devamında internet sayfasından çekilen veriler bulunuyor. Yukarıda şekilde belirtiğim şekilde olması şansı varda süper olacak. Teşekkürler.
 
Erdem Akdemir

Erdem Akdemir

Destek Ekibi
Destek Ekibi
Katılım
4 Mayıs 2007
Mesajlar
3,642
Excel Vers. ve Dili
2016 PRO TÜRKÇE-İNG. 64 BİT
Örnek dosyanızı ekleyebillir misiniz.
 
L

leguminosea

Katılım
25 Mayıs 2010
Mesajlar
218
Excel Vers. ve Dili
2016 Pro Plus TR
L sütunundan sonraki sütunlar zaten etkilenmiyor.
Bölge dosyalarınıda oluştururken sizin verilerinizle beraber oluşturuyor.
Dosyanıza Adlar ve Kayıt sayfalarını taşıyıp, kodlarda Liste yazan yerleri o sayfanın kendi dosyanızdaki adıyla değiştirin yeterli.
Dosyanızın yapısı bozulmuyor.
Neden böyle olmadığını tekrar izah eder misiniz?
 
M

MrExcelMr

Katılım
2 Eylül 2019
Mesajlar
130
Excel Vers. ve Dili
2010-2013-2017 Eng.
@leguminosea,
Hocam dosya içerisinde bir çok sayfa buluyor. Bu dosya sadece bir sayfadan oluşmuş olsa problem yaratmayacak. Dosyanın yanına sizin Adlar ,Kayıt, Liste gibi yeni sayfalar açmam çalıştığım dosyanın yapısını bozacak ve bilgileri paylaştığım kişilerden gereksiz bir çok soru ile karşılacağım. O yüzden kullanıcı tarafından kolay olması hemde benim işlemlerin sırasında bir çok kişiye açıklama yapmak zorunda kamaktan kurtulacağım. Excel bilgisi başlangıç seviyesinde kişilere ileteceğimden dolayı basit şekilde "sayfadaki butona bas karşına ekran gelecek oraya bölgeni yaz. daha sonra tekrar gelen alana Hangi tarihi istiyorsan onu yaz dosya ortak klasörün içerine oluşacak" demem gerekiyor.
 
M

MrExcelMr

Katılım
2 Eylül 2019
Mesajlar
130
Excel Vers. ve Dili
2010-2013-2017 Eng.
@Erdem_34 Hocam öncelikle çok teşekkür ederim.
Bölge_Araç_Servis_Takibi adında masaüstünde dosya mevcuttur. Aktar butonuna bastığımda yeni klasör açmayıp var olan dosyanın içerisine Ankara.xlsm dosyayı oluşturabilir mi?
 
Korhan Ayhan

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
42,751
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Bende hazırlamıştım. Alternatif olsun.

C++: 
Option Explicit

Sub Aktar()
    Dim Yol As String, S1 As Worksheet, S2 As Worksheet, Veri As Variant
    Dim Kriter As Variant, K1 As Workbook, Son As Long
   
    Veri = Application.InputBox("Bölge adını ve arıza tarihini giriniz!" & _
             Chr(10) & Chr(10) & "Örnek ; ANKARA,01.06.2020 11:00:00", "KRİTER GİRİŞİ")
          
    If Veri = "" Or Veri = False Then Exit Sub
   
    Set S1 = Sheets("Sayfa1")
   
    Yol = CreateObject("WScript.Shell").SpecialFolders("Desktop") & Application.PathSeparator & "Bölge Araç Servis Takibi"
    If Dir(Yol, vbDirectory) = "" Then MkDir (Yol)
   
    If InStr(1, Veri, ",") = 0 Then Veri = Veri & ","

    Kriter = Split(Veri, ",")
   
    On Error Resume Next
    S1.ShowAllData
    On Error GoTo 0
   
    With S1
        .Range("A1").AutoFilter 1, Kriter(0)
        If Kriter(1) <> "" Then .Range("A1").AutoFilter 6, Array(2, Format(CDate(Kriter(1)), "dd/mm/yyyy hh:mm"))
        Son = .Cells(.Rows.Count, 1).End(3).Row
        If Son > 1 Then
            Set K1 = Workbooks.Add(1)
            Set S2 = K1.Sheets(1)
            .Range("A1").CurrentRegion.Copy S2.Range("A1")
            S2.Columns.AutoFit
            Application.DisplayAlerts = False
            K1.SaveAs Yol & Application.PathSeparator & Kriter(0) & ".xlsm", 52
            K1.Close
            Application.DisplayAlerts = True
            .ShowAllData
            MsgBox "Aktarım işlemi tamamlanmıştır.", vbInformation
        Else
            .ShowAllData
            MsgBox "Aradğınız kriter bulunamadı!", vbCritical
        End If
    End With

    Set S1 = Nothing
    Set S2 = Nothing
    Set K1 = Nothing
End Sub
 
M

MrExcelMr

Katılım
2 Eylül 2019
Mesajlar
130
Excel Vers. ve Dili
2010-2013-2017 Eng.
@Korhan Ayhan Bey çok teşekkür ederim. Elinize sağlık.

Arıza Tarihi verileri "dd/mm/yyyy hh:mm") formatında, Inputbox girişinde kullanıcı sadece tarihi girebilir mi? tüm verilere ulaşabilmesi için güncelleme yapabilir misiniz.
 
Erdem Akdemir

Erdem Akdemir

Destek Ekibi
Destek Ekibi
Katılım
4 Mayıs 2007
Mesajlar
3,642
Excel Vers. ve Dili
2016 PRO TÜRKÇE-İNG. 64 BİT
Dosya'da küçük bir değişiklik yaptım. Şimdi daha iyi oldu.
 
M

MrExcelMr

Katılım
2 Eylül 2019
Mesajlar
130
Excel Vers. ve Dili
2010-2013-2017 Eng.
Korhan Ayhan' Alıntı:
Bende hazırlamıştım. Alternatif olsun.

C++: 
Option Explicit

Sub Aktar()
    Dim Yol As String, S1 As Worksheet, S2 As Worksheet, Veri As Variant
    Dim Kriter As Variant, K1 As Workbook, Son As Long
   
    Veri = Application.InputBox("Bölge adını ve arıza tarihini giriniz!" & _
             Chr(10) & Chr(10) & "Örnek ; ANKARA,01.06.2020 11:00:00", "KRİTER GİRİŞİ")
          
    If Veri = "" Or Veri = False Then Exit Sub
   
    Set S1 = Sheets("Sayfa1")
   
    Yol = CreateObject("WScript.Shell").SpecialFolders("Desktop") & Application.PathSeparator & "Bölge Araç Servis Takibi"
    If Dir(Yol, vbDirectory) = "" Then MkDir (Yol)
   
    If InStr(1, Veri, ",") = 0 Then Veri = Veri & ","

    Kriter = Split(Veri, ",")
   
    On Error Resume Next
    S1.ShowAllData
    On Error GoTo 0
   
    With S1
        .Range("A1").AutoFilter 1, Kriter(0)
        If Kriter(1) <> "" Then .Range("A1").AutoFilter 6, Array(2, Format(CDate(Kriter(1)), "dd/mm/yyyy hh:mm"))
        Son = .Cells(.Rows.Count, 1).End(3).Row
        If Son > 1 Then
            Set K1 = Workbooks.Add(1)
            Set S2 = K1.Sheets(1)
            .Range("A1").CurrentRegion.Copy S2.Range("A1")
            S2.Columns.AutoFit
            Application.DisplayAlerts = False
            K1.SaveAs Yol & Application.PathSeparator & Kriter(0) & ".xlsm", 56
            K1.Close
            Application.DisplayAlerts = True
            .ShowAllData
            MsgBox "Aktarım işlemi tamamlanmıştır.", vbInformation
        Else
            .ShowAllData
            MsgBox "Aradğınız kriter bulunamadı!", vbCritical
        End If
    End With

    Set S1 = Nothing
    Set S2 = Nothing
    Set K1 = Nothing
End Sub
Genişletmek için tıkla ...
Korhan bey,

Sadece Bölge yazıyorum. Oluşan her excel dosyasında resimdeki hata yazıyor ve açılmıyor.
 
Korhan Ayhan

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
42,751
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
#11 nolu mesajımda ki kodda küçük bir düzeltme yaptım. Tekrar deneyiniz.
 
M

MrExcelMr

Katılım
2 Eylül 2019
Mesajlar
130
Excel Vers. ve Dili
2010-2013-2017 Eng.
Korhan Ayhan' Alıntı:
#11 nolu mesajımda ki kodda küçük bir düzeltme yaptım. Tekrar deneyiniz.
Genişletmek için tıkla ...
Şu anda hata vermiyor dosya açılıyor.
Arıza Tarihi verileri "dd/mm/yyyy hh:mm") formatında, Inputbox girişinde kullanıcı sadece tarihi girebilir mi? tüm verilere ulaşabilmesi için güncelleme yapabilir misiniz.
 
Korhan Ayhan

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
42,751
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Peki tarih yazılınca o tarihe ait bütün saatler mi aktarılacak?
 
Korhan Ayhan

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
42,751
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Deneyiniz.

C++: 
Option Explicit

Sub Aktar()
    Dim Yol As String, S1 As Worksheet, S2 As Worksheet, Veri As Variant
    Dim Kriter As Variant, K1 As Workbook, Son As Long
    
    Veri = Application.InputBox("Bölge adını ve arıza tarihini giriniz!" & _
             Chr(10) & Chr(10) & "Örnek ; ANKARA,01.06.2020 11:00:00", "KRİTER GİRİŞİ")
           
    If Veri = "" Or Veri = False Then Exit Sub
    
    Set S1 = Sheets("Sayfa1")
    
    Yol = CreateObject("WScript.Shell").SpecialFolders("Desktop") & Application.PathSeparator & "Bölge Araç Servis Takibi"
    If Dir(Yol, vbDirectory) = "" Then MkDir (Yol)
    
    If InStr(1, Veri, ",") = 0 Then Veri = Veri & ","

    Kriter = Split(Veri, ",")
    
    On Error Resume Next
    S1.ShowAllData
    On Error GoTo 0
    
    With S1
        .Range("A1").AutoFilter 1, Kriter(0)
        If Kriter(1) <> "" Then .Range("A1").AutoFilter 6, ">=" & CLng(CDate(Kriter(1))), xlAnd, "<" & CLng(CDate(Kriter(1)) + 1)
        Son = .Cells(.Rows.Count, 1).End(3).Row
        If Son > 1 Then
            Set K1 = Workbooks.Add(1)
            Set S2 = K1.Sheets(1)
            .Range("A1").CurrentRegion.Copy S2.Range("A1")
            S2.Columns.AutoFit
            Application.DisplayAlerts = False
            K1.SaveAs Yol & Application.PathSeparator & Kriter(0) & ".xlsm", 52
            K1.Close
            Application.DisplayAlerts = True
            .ShowAllData
            MsgBox "Aktarım işlemi tamamlanmıştır.", vbInformation
        Else
            .ShowAllData
            MsgBox "Aradğınız kriter bulunamadı!", vbCritical
        End If
    End With

    Set S1 = Nothing
    Set S2 = Nothing
    Set K1 = Nothing
End Sub
 
Cevap yazmak için giriş yap yada kayıt ol.
Üst