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 06-08-2004, 14:53   #1
evren_01
 
Giriş: 06/07/2004
Şehir: Burdur
Mesaj: 159
Excel Vers. ve Dili:
Microsoft® Office 2016 TR
Varsayılan Sayfa 2 deki isimlerin karşısına değeri yazma

Arkadaşlar bu makroda yardımlarını beliyorum
Burada yapmak istediğim
sayfa 1 de B14:b44 arasında isimlerin karşısında bulunan d14:d44 arasında ise saatleri
Sayfa 2 deki isimlerin karşındaki kutulara değeri yazmasını istiyorum
Sorun şu Sayfa 2 deki a2:a11 asındaki kişileri yazıyor sonra siliyor.


Sub çizelge()
Dim tarih As String
Dim isim As String
Dim son As Integer
Dim satir, sutun, i As Integer
Dim tarihalani, isimalani, tarih1, isim1 As Range
On Error Resume Next
son = Sheets("sayfa2").Range("a65536").End(xlUp).Row
Set tarihalani = Sheets("sayfa2").Range("c1:ag1")
Set isimalani = Sheets("sayfa2").Range("a3:a" & son + 15)
tarih = Sheets("sayfa1").Range("A1").Value

For i = 13 To son
isim = Sheets("sayfa1").Range("B" & i).Value
Set tarih1 = tarihalani.Find(tarih)
Set isim1 = isimalani.Find(isim)
If tarih1 Is Nothing Then
MsgBox "Aradığınız isim ve ya tarih bulunamadı.", vbCritical, "Arama Sonucu."
Exit Sub
Else:
sutun = tarih1.Column
satir = isim1.Row
Sheets("sayfa2").Cells(satir, sutun) = Sheets("sayfa1").Cells(i, 4)
End If
Next i
'Range("A1").Select

End Sub
evren_01 Çevrimdışı   Alıntı Yaparak Cevapla
Eski 06-08-2004, 15:57   #2
uzaylı
 
Giriş: 05/08/2004
Şehir: istanbul
Mesaj: 10
Varsayılan

Merhaba,

Kodlarınızı bir kaç ufak değişiklikle çalıştırdım ve bir sorunla karşılaşmadım.
Kod: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
Sub çizelge()
    Dim Tarih
    Dim isim As String
    Dim Son As Integer
    Dim satir, sutun, i
    Dim tarihalani As Range, isimalani As Range, tarih1 As Range, isim1 As Range

    On Error Resume Next
    
    Son = Sheets("sayfa2").Range("a65536").End(xlUp).Row
    Set tarihalani = Sheets("sayfa2").Range("c1:ag1")
    Set isimalani = Sheets("sayfa2").Range("a3:a" & Son + 15)
    Tarih = Sheets("sayfa1").Range("A1").Value

    For i = 13 To Sheets("sayfa1").Range("b65536").End(xlUp).Row
        isim = Sheets("sayfa1").Range("B" & i).Value
        Set tarih1 = tarihalani.Find(Tarih, lookat:=xlWhole)
        Set isim1 = isimalani.Find(isim)
        
        If tarih1 Is Nothing Then
            MsgBox "Aradığınız isim ve ya tarih bulunamadı.", vbCritical, "Arama Sonucu."
            Exit Sub
        Else
            sutun = tarih1.Column
            satir = isim1.Row
            Sheets("sayfa2").Cells(satir, sutun) = Sheets("sayfa1").Cells(i, 4)
        End If
    Next i
End Sub
Bu kodları bir denermisiniz?
uzaylı Çevrimdışı   Alıntı Yaparak Cevapla
Eski 07-08-2004, 07:56   #3
evren_01
 
Giriş: 06/07/2004
Şehir: Burdur
Mesaj: 159
Excel Vers. ve Dili:
Microsoft® Office 2016 TR
Varsayılan

dostum ilginize teşekkür ederim
yanlız aradığınız isim ve tarih bulunamadı diyor
evren_01 Çevrimdışı   Alıntı Yaparak Cevapla
Eski 07-08-2004, 08:50   #4
uzaylı
 
Giriş: 05/08/2004
Şehir: istanbul
Mesaj: 10
Varsayılan

Merhaba,

Kod bende çalışıyor. Yani Sayfa1 in A1 hücresindeki değeri Sayfa2 nin C1:AG1 aralığında arıyor varsa buluyor.

Eğer sizin sayfanız da bu şekilde ve tarih değeri C1:AG1 aralığında var ise bulması gerekir. Muhtemelen bir Format sorunu olabilir. Bu aralıkların ve A1 hücresinin tarih formatında olması gerekir. Ve sizin ilk kodunuzda ki gibi
Kod: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
Dim Tarih As String
değilde
Kod: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
Dim Tarih
şeklinde tanımlanması gerekir.

Bu hususlara dikkat ederseniz çalışması gerekir.

Kolay gelsin
uzaylı Çevrimdışı   Alıntı Yaparak Cevapla
Eski 07-08-2004, 10:09   #5
evren_01
 
Giriş: 06/07/2004
Şehir: Burdur
Mesaj: 159
Excel Vers. ve Dili:
Microsoft® Office 2016 TR
Varsayılan

Dostum
Benim size verdiğim makrp güzel çalışıyor yanlız küçük bir sorun var sayfa 2 de kişilerin yanına rakamları yazıyor sonra bunları siliyor bunu engellemek istiyorum . umarım acıklayıcı olmuşumdur
evren_01 Çevrimdışı   Alıntı Yaparak Cevapla
Eski 07-08-2004, 12:15   #6
uzaylı
 
Giriş: 05/08/2004
Şehir: istanbul
Mesaj: 10
Varsayılan

Merhaba,

Sizin kodlarınızda verileri silen bir kod göremedim. Eğer dosyanızı bana gönderebilirseniz yardımcı olmaya çalışırım.

Not: Ã?zel mesajlarınıza bakınız...
uzaylı Çevrimdışı   Alıntı Yaparak Cevapla
Eski 10-08-2004, 16:27   #7
evren_01
 
Giriş: 06/07/2004
Şehir: Burdur
Mesaj: 159
Excel Vers. ve Dili:
Microsoft® Office 2016 TR
Varsayılan

Hüseyin beye ve Uzaylıya sorunun çözümünde yardımcı olduklarından dolayı teşekkür ederim.


Kod: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
Sub çizelge()
Dim tarih As Date
Dim isim As String
Dim son As Integer
Dim satir, sutun, i As Integer
Dim tarihalani, isimalani, tarih1, isim1 As Range
On Error Resume Next
son = Sheets("sayfa1").Range("B65536").End(xlUp).Row 'sayfa1 ve B65536 olarak değiştirdim.
Set tarihalani = Sheets("sayfa2").Range("d1:ah1")
Set isimalani = Sheets("sayfa2").Range("a3:a53")
tarih = Sheets("sayfa1").Range("B11").Value

For i = 17 To son
isim = Sheets("sayfa1").Range("B" & i).Value
Set tarih1 = tarihalani.Find(tarih)
Set isim1 = isimalani.Find(isim)
If tarih1 Is Nothing Then
MsgBox "Aradığınız isim ve ya tarih bulunamadı.", vbCritical, "Arama Sonucu."
Exit Sub
Else:
sutun = tarih1.Column
satir = isim1.Row
    Sheets("sayfa2").Cells(satir, sutun) = Sheets("sayfa1").Cells(i, 4)
End If
Next i
'Range("A1").Select

End Sub
evren_01 Ç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 23:01


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