• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

satırdaki değerleri bulup kopyalama

acar6783

acar6783

Katılım
6 Temmuz 2008
Mesajlar
1,875
Excel Vers. ve Dili
OFFİCE 2010- TÜRKÇE
merhabalar,

ekteki çalışma sayfamda yapmaya calıştığım;

a sütunundaki ''' kırtasiye ''' yazan hücrelerin karşısındaki değerleri
a1 karşısına kırtasiye
a2 karşısına barkod
a3 karşısına birimi
a4 karşısına birim fiyatını
yazması..
yapılabilirmi ?
teşekkürler ..

(not: kırtasiye yazan satır 1den fazla olabliyor..)
 

Ekli dosyalar

Son düzenleme:
Merhaba,
Eksik anlatım nedeniyle düzeltme yapmışsınız ama hala eksik anlatım var.
- İstedikleriniz aynı sayfaya mı yapılacak? Bu durumda verileriniz silinir.
-Ayrı sayfaya yapılacaksa dosyanıza örnek bir sayfa eklemeliydiniz.
- "a1 karşısına kırtasiye" A1 in karşısı B1 olmalı, bunu mu demek istediniz?
ÖZET:Olmasını istediğniz sayfa için örnrk ekleyiniz.
 
yanıt

ekte yine acıklamay calıştım inşallah anlatabilmişimdir
 

Ekli dosyalar

Merhaba,
Dosyanız ilişiktedir.
Kod: 
Sub Aktar()
Set s1 = Sheets("Sayfa1")
Set s2 = Sheets("acıklama")
For i = 1 To s1.[A65536].End(3).Row
    If Cells(i, 1).Value = "KIRTASİYE" Then
        ss = IIf(s2.Cells(1, 1) = "", 1, s2.[A65536].End(3).Row + 3)
        s2.Cells(ss + 0, 1).Value = s1.Cells(i, 1).Value
        s2.Cells(ss + 1, 1).Value = s1.Cells(i, 6).Value
        s2.Cells(ss + 2, 1).Value = "'" & s1.Cells(i, 4).Value
        s2.Cells(ss + 3, 1).Value = s1.Cells(i, 3).Value
        s2.Cells(ss + 4, 1).Value = s1.Cells(i, 5).Value
    End If
Next
MsgBox "Aktarma işlemi tamamlanmıştır.", vbInformation
End Sub
 

Ekli dosyalar

hocam ben bu işlemi başka çalışma sayfasından getirtebilirmiyim .. (misal x çalışma kitabının 78. sayfasından)
bir de her butona bastığımda önce ki verinin sıfırlanma gibi bir durumu olabilirmi.
saygılar..
 
acar6783' Alıntı:
hocam ben bu işlemi başka çalışma sayfasından getirtebilirmiyim .. (misal x çalışma kitabının 78. sayfasından)..
Genişletmek için tıkla ...
Bunun için yukarıdaki kodu x çalışma kitabında bir modüle yapıştırıp;Set s1 = Sheets("Sayfa1") satırındaki Sayfa1 in yerine istediğiniz sayfa numarasını yazmanız yeterlidir.
acar6783' Alıntı:
bir de her butona bastığımda önce ki verinin sıfırlanma gibi bir durumu olabilirmi...
Genişletmek için tıkla ...
Aşağıdaki satırı koddaki For ..ile başlayan satırdan önceye ekleyiniz.
Kod: 
s2.Cells.ClearContents
 
dEdE' Alıntı:
Bunun için yukarıdaki kodu x çalışma kitabında bir modüle yapıştırıp;Set s1 = Sheets("Sayfa1") satırındaki Sayfa1 in yerine istediğiniz sayfa numarasını yazmanız yeterlidir.

HOCAM ÖNCELİKLE TEŞEKKÜR EDERİM İLGİNİZE ...
FAKAT;
X ÇALIŞMA KİTABI HERGÜN GÜNCELLENECEK BİR SAYFA OLDUĞUNDAN O DOSYA İLE İLGİLİ BİR MAKRO KAYDI YAPAMIYORUM YAPSAM DA ÜZERİEN KAYIT YAPACAĞIMDAN KAYIT KAYBOLACAKTIR SANIRIM..
DOLAYISI İLE X DOSYASINDAN VERİYİ DOSYA KAPALI OLSA BİLE AKTARMASI GEREKİCEK MESELA
=[X.xls]Sheet78!$A$4 YAPTIĞIMIZDA HERHANGİ BİR HÜCREYE O HÜCREYE X SAYFASINDAKİ A4 HÜCRESİNİN DEĞERİNİ KAPALI OLSA BİLE GETİRİYOR..

BUNUN GİBİ BİR KOD İLE X DOSYASINDAKİ VERİLERİ BİZİM KİTAP1 ADLI DOSYAMIZIN SAYFA 1 İNE KOPYALIYACAK VE DEVAMINDA DA DİĞER KODLAR CALISACAK ..
Genişletmek için tıkla ...
 
Merhaba,
Konu tamamen değişti. Kapalı dosyadan veri alma konusuna girdik. Bu konuda forumda birçok örnek var. Arama yaparsanız bulursunuz.
Bu arada, büyük harfle yazmak bağırmak anlamına gelir ki;net ortamında pek hoş karşılanmaz.
 
dEdE' Alıntı:
Merhaba,
Konu tamamen değişti. Kapalı dosyadan veri alma konusuna girdik. Bu konuda forumda birçok örnek var. Arama yaparsanız bulursunuz.
Bu arada, büyük harfle yazmak bağırmak anlamına gelir ki;net ortamında pek hoş karşılanmaz.
Genişletmek için tıkla ...

özür dilerim yanlış anlaşıldıysam;
niyetim bağırmak değil caps lock açık kaldığından devam ettim o şekilde..
sabahtır araştıryorum fakat tam aradığım şeye cevap bulamadım açıkcası
normal yöntemle ben her hücreye =koyup diğer calışma kitabında almak isteğim hücreyi seçersem oluyor fakat bunu yapmak saatlerimi alır ..
sadece = yapım komple diğer kitabın bir sayfasını olduğu gibi kopyalacak bir formul de yok gibi..
nasıl bir şey yapabiliriz sizce
 
hocam,
excelde veri alma bölümünden bir yol ile istediğim dosyadan veri alabiliyorum fakat her seferinde yenilememi istiyor bunun makro yada formül ile başka bir yolu varmıdır..
ya da başta yapmış olduğumuz kodu sayfa1 e göre değilde x çalışma kitabının 78. sayfası olarak değiştirebilirmiyiz..
 
dEdE' Alıntı:
Merhaba,
Dosyanız ilişiktedir.
Kod: 
Sub Aktar()
Set s1 = Sheets("Sayfa1")
Set s2 = Sheets("acıklama")
For i = 1 To s1.[A65536].End(3).Row
    If Cells(i, 1).Value = "KIRTASİYE" Then
        ss = IIf(s2.Cells(1, 1) = "", 1, s2.[A65536].End(3).Row + 3)
        s2.Cells(ss + 0, 1).Value = s1.Cells(i, 1).Value
        s2.Cells(ss + 1, 1).Value = s1.Cells(i, 6).Value
        s2.Cells(ss + 2, 1).Value = "'" & s1.Cells(i, 4).Value
        s2.Cells(ss + 3, 1).Value = s1.Cells(i, 3).Value
        s2.Cells(ss + 4, 1).Value = s1.Cells(i, 5).Value
    End If
Next
MsgBox "Aktarma işlemi tamamlanmıştır.", vbInformation
End Sub
Genişletmek için tıkla ...

hocam butonu calısma sayfasına eklediğimde hicbir veri getirmiyor nedendir sizce
 
"... x çalışma kitabının 78. sayfası olarak değiştirebilirmiyiz..."
Genişletmek için tıkla ...
Bunun için aşağıdaki kodu kullanabilirsiniz. Dosya yolu, dosya adı veri alınacak sayfa adı ve verinin geleceği sayfa adlarını kendinize göre değiştirmeyi unutmayınız. Kod içinde gerekli açıklamaları yaptım.

Kod: 
Sub Veri_Al()
    Yol = "C:\Deneme\" 'Veri alacağınız Dosya yolunu düzenleyin
    Set CObj = CreateObject("Excel.Application")
    Set WBook1 = CObj.Workbooks.Open(Yol & "x.xls") 'Dosya adını düzenleyin
    Set Wsheet1 = WBook1.Sheets("Sayfa78") 'Veri alacağınız Sayfa adını düzenleyin
    DSS = Wsheet1.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    DSK = Wsheet1.Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
    If DSK > 26 Then
        kolon = Chr(Int((DSK - 1) / 26) + 64) & Chr(((DSK - 1) Mod 26) + 65)
    Else
        kolon = Chr(DSK + 64)
    End If
    'Alt satırda verinin geleceği sayfa adını düzenleyin
    Sheets("Sayfa2").Range("A1:" & kolon & DSS).Value = Wsheet1.Range("A1:" & kolon & DSS).Value
    WBook1.Close 0
    CObj.Quit
    MsgBox "Veri alma işlemi tamamlandı.", vbInformation, "dEdE Başarılar diler.."
End Sub
acar6783' Alıntı:
hocam butonu calısma sayfasına eklediğimde hicbir veri getirmiyor nedendir sizce
Genişletmek için tıkla ...
Butona makro ataması yapmamış olabilir misiniz? Ya da CommanButton eklediniz ise kodları butonun kod bölümüne taşımamış olabilir misiniz?
 
Butona makro ataması yapmamış olabilir misiniz? Ya da CommanButton eklediniz ise kodları butonun kod bölümüne taşımamış olabilir misiniz?

cok teşekkür ederim vermiş olduğunuz bilgiler için ...

hocam yaptığımda bir hata olmadığını düşnüyorum fakat 2.sayfada butonu çalıştırdığımda verileri getirmiyoruz dosyamı ekliyorum kontrol edebilirmsiniz..
saygılarımla
 

Ekli dosyalar

Merhaba,
Koddaki şu satırı
Kod: 
 If Cells(i, 1).Value = "KIRTASİYE" Then
aşağıdaki ile değiştirin.
Kod: 
 If s1.Cells(i, 1).Value = "KIRTASİYE" Then
 
dEdE' Alıntı:
Merhaba,
Koddaki şu satırı
Kod: 
 If Cells(i, 1).Value = "KIRTASİYE" Then
aşağıdaki ile değiştirin.
Kod: 
 If s1.Cells(i, 1).Value = "KIRTASİYE" Then
Genişletmek için tıkla ...


Hocam çok sağolun teşekkürederim ilginize ,

fakat makroda kendimi biraz daha geliştirme amaçlı
yazdığımız makroyu okuyabilirmisiniz ..

yani hangi satır/işaret ne anlama geliyor..
 
Merhaba,
İstediğinizi yapmak kodu yazmaktan zormuş. :) Bir modüle yapıştırarak okursanız daha kolay olur. Açıklama satırları renkli olarak görünür.
Kod: 
Sub Aktar()
'Sayfa adını her seferinde uzun yazmamak için kısaltıyoruz.
Set s1 = Sheets("Sayfa1")
Set s2 = Sheets("ETİKET")
'ETİKET sayfasını temizliyoruz.
s2.Cells.ClearContents
'Sayfa1'in A sütununda ilk satırdan başlayarak dolu son satırakadar döngü oluşturuyoruz.
For i = 1 To s1.[A65536].End(3).Row
'Eğer ilgili satırda KIRTASİYE yazıyorsa işlem yap diyoruz. _
    Başka birşey yazıyorsa atlayarak işleme devam ediyoruz.
    If s1.Cells(i, 1).Value = "KIRTASİYE" Then
'ETİKET sayfasının son dolu satırını bulup 1 ekleyerek ilk boş satıra ulaşıyoruz.
        ss = IIf(s2.Cells(1, 1) = "", 1, s2.[A65536].End(3).Row + 1)
'Son dolu satırdan başlayarak bir kayda ait istenilen verileri yazıyoruz.
        s2.Cells(ss + 0, 1).Value = s1.Cells(i, 3).Value
        s2.Cells(ss + 1, 1).Value = s1.Cells(i, 4).Value
        s2.Cells(ss + 2, 1).Value = "'" & s1.Cells(i, 2).Value
  End If
'Dönüp sonraki kaydı kontrol ediyoruz.
Next
'Kayıtlar bittiğinde mesaj verip çıkıyoruz.
MsgBox "Aktarma işlemi tamamlanmıştır.", vbInformation
End Sub
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst