Makro ile düşeyara yapabilirmiyiz

Katılım
24 Şubat 2010
Mesajlar
281
Excel Vers. ve Dili
EXCEL 2003
B hücresinden seçim yapınca C hüçresine düseyara ile isimler ve G hücresine otomatik tarih atıyor geliyor sayfadaki veri çogalınca veri yavas gelmeye basladı
makro ile düşeyara yapabilirmiyiz isimleri parametre sayfasından çekecek
 

Ekli dosyalar

Katılım
2 Temmuz 2009
Mesajlar
542
Excel Vers. ve Dili
office 2019 Türkçe
Makro kaydet ile yapabilirsiniz. Makro kaydetmeye basın. Formüllü hücreye tıklayıp entere basın. Gerekiyorsa formülü aşağıya çekin. Makro kayıtı durdurun. İşlem tamamdır.
 
Katılım
24 Şubat 2010
Mesajlar
281
Excel Vers. ve Dili
EXCEL 2003
makro kaydet işimi görmuyor formul sayfayı kasıyor bir makro buldum uyarlıymadım




Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("B2:B" & Rows.Count)) Is Nothing Then Exit Sub
Set s1 = Sheets("parametreler")
If Selection > 1 Then Exit Sub
If Target = "" Then Exit Sub
son = s1.Cells(Rows.Count, "e").End(3).Row
If WorksheetFunction.CountIf(s1.Range("E1:E" & son), Target) > 1 Then
MsgBox "Girilen veri birden fazla kayıt içeriyor!", vbCritical
Target.Select
Exit Sub
ElseIf WorksheetFunction.CountIf(s1.Range("E1:E" & son), Target) = 0 Then
MsgBox "Girilen veri bulunamadı!", vbCritical
Target.Select
Exit Sub
Else
a = WorksheetFunction.Match(Target, s1.Range("E1:E" & son), 0)
Target.Offset(0, 1) = s1.Cells(a, "A")
Target.Offset(0, 1) = s1.Cells(a, "f")
End If
End Sub
 

Necdet

Moderatör
Yönetici
Katılım
4 Haziran 2005
Mesajlar
15,181
Excel Vers. ve Dili
Ofis 365 Türkçe
Merhaba,

Aşağıdaki kodları dener misiniz? Kodlar ilgili sayfanın kod bölümünde olmalı.

Sizin kodlarınızı dikkate almadım, ne amaçla yazdığınızı bilmediğimden.

Kod:
Private Sub Worksheet_Change(ByVal Target As Range)

    If Intersect(Target, [B:B]) Is Nothing Or Target.Row < 5 Or Target.Value = "" Then Exit Sub
    Dim c As Range
    
    Set c = Sheets("Parametreler").Range("E:E").Find(Target.Value, LookIn:=xlValues, LookAt:=xlWhole)
    If Not c Is Nothing Then
        Target.Offset(0, 1) = Sheets("Parametreler").Range("F" & c.Row)
    Else
        Target.Offset(0, 1) = "Bulunamadı.."
    End If
    
End Sub
 
Katılım
24 Şubat 2010
Mesajlar
281
Excel Vers. ve Dili
EXCEL 2003
tesekkurler
 
Üst