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 05-12-2013, 10:06   #1
Burak12
 
Giriş: 03/11/2013
Mesaj: 32
Excel Vers. ve Dili:
Excel 2010 Türkçe
Varsayılan Kapalı dosyadan veri çağırma

Arkadaşlar benim istediğim olay , data sayfasında yazılı olan makina adına göre diğer çalışma kitabına ilgili yerllerin getirilmesidir.ben sitede örnekleri inceleyerek yapmaya çalıştım ama bir adım bile ileri gidemedim
yardım edecek arakadaşlara şimdiden teşekkür ederim
Eklenmiş Dosyalar
Dosya Türü: rar Desktop.rar (15.6 KB, 15 Görüntülenme)
Burak12 Çevrimdışı   Alıntı Yaparak Cevapla
Eski 05-12-2013, 18:46   #2
Burak12
 
Giriş: 03/11/2013
Mesaj: 32
Excel Vers. ve Dili:
Excel 2010 Türkçe
Varsayılan

Arkadaşlar yardımcı olabilirmisiniz
Burak12 Çevrimdışı   Alıntı Yaparak Cevapla
Eski 05-12-2013, 21:04   #3
Emir Hüseyin Çoban
Destek Ekibi
 
Emir Hüseyin Çoban kullanıcısının avatarı
 
Giriş: 11/08/2008
Şehir: Denizli
Mesaj: 5,678
Excel Vers. ve Dili:
Office 2013 Tr - Win8 x64
Varsayılan

. . .

Öneri:

Bir makina için Bakım sayfasının doldurulmuş halini ekleyiniz.
Örneğin: BOB CAT veya FORKLİFT 10 TON
Böylece kodlama sonunda verilerin doğru mu geldiğini kontrol edebiliriz.

. . .
__________________
.
Cüzzi Ücretlerle Sorularınıza Özel Destek Almak İçin Özel Mesaj Yazabilirsiniz...

e-mail: huseyincobann@gmail.com
Tel: 0531-285-06-15

http://www.excel.web.tr/private.php?do=newpm&u=101759

Örnek Dosya Hazırlarken Dikkat Edilmesi Gerekenler için link:
https://goo.gl/ckn2NC
_

İyi Günler...

Türkçe konuşup, Excel'ce yazıyoruz!..
...:::: Diren #Excel.Web.Tr :::....


Emir Hüseyin Çoban Çevrimdışı   Alıntı Yaparak Cevapla
Eski 05-12-2013, 21:34   #4
Burak12
 
Giriş: 03/11/2013
Mesaj: 32
Excel Vers. ve Dili:
Excel 2010 Türkçe
Varsayılan

hüseyin bey sizin istediğiniz gibi yaptım bobcat ve forklift 10 ton seçimini yaparsak formun nasıl hal alacağını yaptım.Umarım bu sefer açıklayıcı olmuştur
Eklenmiş Dosyalar
Dosya Türü: xls YENİ CALIŞMA SAYFASI.xls (38.0 KB, 10 Görüntülenme)
Burak12 Çevrimdışı   Alıntı Yaparak Cevapla
Eski 05-12-2013, 21:59   #5
Emir Hüseyin Çoban
Destek Ekibi
 
Emir Hüseyin Çoban kullanıcısının avatarı
 
Giriş: 11/08/2008
Şehir: Denizli
Mesaj: 5,678
Excel Vers. ve Dili:
Office 2013 Tr - Win8 x64
Varsayılan

. . .

Ekteki dosyayı inceleyiniz.
Aratılan makina isimleri, Data tablosundaki makina isimleri ile aynı olmalı.
Örneğin BOBCAT makinasında iki tablodaki yazılışları farklıydı.
İki tablo aynı klasör içinde olmalı.

Çalışma Sonucu:


Kod: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
Sub KOD()
Application.DisplayAlerts = False
Application.ScreenUpdating = False

Dim KKapalı As Worksheet
Dim KAçık As Worksheet
Dim ARA


yol = ThisWorkbook.Path & "\DATA.xls"
Workbooks.Open (yol)

Set KKapalı = Workbooks("DATA").Sheets("Sayfa1")
Set KAçık = Workbooks("YENİ CALIŞMA SAYFASI").Sheets("BAKIM")

KAçık.Range("C7,D11:D35").ClearContents

Set ARA = KKapalı.Range("A:A").Find(KAçık.Range("E3"), , xlValues, xlWhole)
If Not ARA Is Nothing Then

sonsütun = KKapalı.Cells(ARA.Row, "A").End(2).Column

If sonsütun > 25 Then
MsgBox "Bakım Sayfası Satırları Listeleme İçin Yeterli Değil", vbCritical
Workbooks("DATA").Close False
Exit Sub
End If

KAçık.Range("C7") = KKapalı.Cells(ARA.Row, "B")

satır = 11
For i = 3 To sonsütun

KAçık.Cells(satır, "D") = KKapalı.Cells(ARA.Row, i)
satır = satır + 1
Next i


Else
MsgBox KAçık.Range("E3") & " Yok ", vbCritical
Workbooks("DATA").Close False
Exit Sub
End If


Workbooks("DATA").Close False

Application.DisplayAlerts = True
Application.ScreenUpdating = True
MsgBox " B i t t i "
End Sub
. . .
Eklenmiş Resimler
Dosya Türü: jpg 1_02.jpg (84.7 KB, 108 Görüntülenme)
Eklenmiş Dosyalar
Dosya Türü: rar Data_02.rar (23.9 KB, 28 Görüntülenme)
__________________
.
Cüzzi Ücretlerle Sorularınıza Özel Destek Almak İçin Özel Mesaj Yazabilirsiniz...

e-mail: huseyincobann@gmail.com
Tel: 0531-285-06-15

http://www.excel.web.tr/private.php?do=newpm&u=101759

Örnek Dosya Hazırlarken Dikkat Edilmesi Gerekenler için link:
https://goo.gl/ckn2NC
_

İyi Günler...

Türkçe konuşup, Excel'ce yazıyoruz!..
...:::: Diren #Excel.Web.Tr :::....


Emir Hüseyin Çoban Çevrimdışı   Alıntı Yaparak Cevapla
Eski 06-12-2013, 10:59   #6
Burak12
 
Giriş: 03/11/2013
Mesaj: 32
Excel Vers. ve Dili:
Excel 2010 Türkçe
Varsayılan

Teşekkür ederim.
Burak12 Çevrimdışı   Alıntı Yaparak Cevapla
Eski 06-12-2013, 20:06   #7
anit35
 
Giriş: 01/05/2011
Şehir: aydın
Mesaj: 42
Excel Vers. ve Dili:
2003 türkçe
Varsayılan slm arkadaşlar bana bu konuda yardım edebilirmisinm

dosyam ekte ayrıntıları içinde var
şimdiden selamlar
Eklenmiş Dosyalar
Dosya Türü: rar VERİ.rar (17.9 KB, 9 Görüntülenme)
anit35 Çevrimdışı   Alıntı Yaparak Cevapla
Eski 06-12-2013, 20:25   #8
Emir Hüseyin Çoban
Destek Ekibi
 
Emir Hüseyin Çoban kullanıcısının avatarı
 
Giriş: 11/08/2008
Şehir: Denizli
Mesaj: 5,678
Excel Vers. ve Dili:
Office 2013 Tr - Win8 x64
Varsayılan

. . .

Dosyanız ektedir.

İşlem Sonucu:


Kod: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
Private Sub Worksheet_Change(ByVal Target As Range)
Dim hcr As Range
If Intersect(Target, Range("A9:A" & Cells(Rows.Count, "A").End(xlUp).Row)) _
Is Nothing Then Exit Sub

Target.Offset(0, 1).Value = ""

Dim Con As Object, Rs As Object
Dim Sorgu As String
Set Con = CreateObject("Adodb.Connection")
Set Rs = CreateObject("Adodb.RecordSet")

If Target.Value = "" Then
Target.Offset(0, 1).Value = ""
Exit Sub
End If

If IsNumeric(Target.Value) = True Then
Target.Value = ""
Target.Offset(0, 1).Value = ""
MsgBox " Metin Verisi Olmalı ", vbCritical
Exit Sub
Else
End If

yol = ThisWorkbook.Path & "\VERİ.xls"

Con.Open "Provider=microsoft.jet.oledb.4.0;data source=" & yol & ";extended properties=""excel 8.0;hdr=no"""
Sorgu = "SELECT f2 FROM [veri$] where f1='" & Target.Value & "'"

Rs.Open Sorgu, Con, 3, 1

If Rs.RecordCount = 0 Then
Target.Offset(0, 1).Value = "Yok"
Else
Target.Offset(0, 1).CopyFromRecordset Rs
End If

Rs.Close
Con.Close

Set Con = Nothing: Set Rs = Nothing: Sorgu = ""
yol = Empty

End Sub
. . .
Eklenmiş Resimler
Dosya Türü: jpg 1_01.jpg (57.0 KB, 92 Görüntülenme)
Eklenmiş Dosyalar
Dosya Türü: rar sedat_01.rar (17.9 KB, 19 Görüntülenme)
__________________
.
Cüzzi Ücretlerle Sorularınıza Özel Destek Almak İçin Özel Mesaj Yazabilirsiniz...

e-mail: huseyincobann@gmail.com
Tel: 0531-285-06-15

http://www.excel.web.tr/private.php?do=newpm&u=101759

Örnek Dosya Hazırlarken Dikkat Edilmesi Gerekenler için link:
https://goo.gl/ckn2NC
_

İyi Günler...

Türkçe konuşup, Excel'ce yazıyoruz!..
...:::: Diren #Excel.Web.Tr :::....


Emir Hüseyin Çoban Çevrimdışı   Alıntı Yaparak Cevapla
Eski 09-12-2013, 16:53   #9
Burak12
 
Giriş: 03/11/2013
Mesaj: 32
Excel Vers. ve Dili:
Excel 2010 Türkçe
Varsayılan

arkadaşlar hüseyin beyden yardm alarak güze bir şey yapmışdı sağolsun.ama ben buna bir kaç ilave yapmak istedim beceremedim 3 saat uğraşlarım sonucu bazı veriler geliyor bazı veriler gelmiyor.sorun nerde acaba ?
Eklenmiş Dosyalar
Dosya Türü: rar Yeni klasör.rar (28.5 KB, 11 Görüntülenme)

Bu mesaj en son " 09-12-2013 " tarihinde saat 19:18 itibariyle Burak12 tarafından düzenlenmiştir....
Burak12 Çevrimdışı   Alıntı Yaparak Cevapla
Eski 09-12-2013, 17:08   #10
Emir Hüseyin Çoban
Destek Ekibi
 
Emir Hüseyin Çoban kullanıcısının avatarı
 
Giriş: 11/08/2008
Şehir: Denizli
Mesaj: 5,678
Excel Vers. ve Dili:
Office 2013 Tr - Win8 x64
Varsayılan

. . .

Hatalı sonuç veren makinalardan bazıları 1-7-8 mi ?

. . .
__________________
.
Cüzzi Ücretlerle Sorularınıza Özel Destek Almak İçin Özel Mesaj Yazabilirsiniz...

e-mail: huseyincobann@gmail.com
Tel: 0531-285-06-15

http://www.excel.web.tr/private.php?do=newpm&u=101759

Örnek Dosya Hazırlarken Dikkat Edilmesi Gerekenler için link:
https://goo.gl/ckn2NC
_

İyi Günler...

Türkçe konuşup, Excel'ce yazıyoruz!..
...:::: Diren #Excel.Web.Tr :::....


Emir Hüseyin Çoban Ç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 05:59


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

Excel Eğitimi - Mobil Uygulama - Çorlu - Çorlu Web Tasarım -- Beylikdüzü mali müşavir - Lingerie - Dyeing Machine - Karton Bardak- Çorlu Dil Konuşma Terapisti- Çorlu Özel Eğitim- Site Yönetimi- Pronet Tekirdağ- Çorlu Kamera- Pronet Edirne- Pronet Çorlu- Çorlu Araç Takip- Çorlu Su Arıtma- Gebze Emlak- Rampa- Rotary- Çorlu İnternet Sitesi- Çorlu Sürücü Kursu- Çorlu Sürücü Kursu- Şişli Avukat- Edirne Serbest Muhasebeci- Çorlu Etüt- İstanbul Botanik- Çorlu Sigorta- Kağıt Bardak- Kaplan Tekstil- Çorlu Perde- Çorlu Havuz- Makina- Danışmazlar-
Powered by vBulletin Version 3.7.2
Copyright ©2000 - 2018, Jelsoft Enterprises Ltd.
Advertisement System V2.6 By   Branden