• DİKKAT

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

hücre her değiştiğinde yeni değeri kayıt etmek

  • Konbuyu başlatan Konbuyu başlatan ADEMES
  • Başlangıç tarihi Başlangıç tarihi
A

ADEMES

Katılım
5 Ocak 2010
Mesajlar
126
Excel Vers. ve Dili
2013
merhaba

aradığım makro , a1 hücresi her değiştiğinde başka sayfaya log tutacak yeni değeri kayıt altına alacak makro kodları.

a1 değerinin her değiştiğinde sayfa2 de a sutununa altalta yeni değeri kayıt edecek.

şimdiden emeğinize sağlık

adem
 
Aşağıdaki kodları kullanabilirsiniz.
Kod: 
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [a1]) Is Nothing Then Exit Sub
Dim SonSatir As Long
SonSatir = Sheets("Sayfa2").Range("A" & Rows.Count).End(xlUp).Row + 1
Sheets("Sayfa2").Cells(SonSatir, 1).Value = Target.Value
End Sub
 
selamlar ,

ilginiz için teşekkürler. bunu altalta oluşturmak için nasıl yapmalıyım yani a2 den a20000 e kadar otomatik değişince sayfa 2 ye aynı şekilde atsın.

birde aynısını b , c , d ,e , f sütünları içinde yapmam gerekiyor.

teşekkürler
adem
 
[A1] değerini [A1:A2000] olarak değiştirin. Diğer sütunlar A sütununa mı gelecek?
 
yok a sutunu a ya b sutunu b ye c sutunu c ye denk gelecek şekilde olacak f ye kadar.

iyi akşamlar
 
tekrar açıklamak isterim

a1 de yazılan , sayfa 2 a sutununa
a2 de yazılan , sayfa 2 b sutununa
a3 te yazılan , sayfa 2 c sutununa

bu şekilde a 10 a kadar olması yeterli .

ilginize teşekkürler
adem
 
gemi pozisyonlarını listelediğimiz bir dosyamız var ve cok zamanımızı alıyor bunu en aza indirmeye calısıyorum.

öncelikle b2,b3,b4 ve b5 e girilen bilgileri diğer sayfada a2 , b2 , c2 , d2 de otomatik olarak oluşturmak istiyorum.

bunu yaparken tekrarlamayı önlemek için , ( a sutununda k bilgi tekrarlamamalı ) eğer a sutununda daha önceden girilmiş aynı data çıkarsa daha onceki datanın girildiği satırın d sutununu yeni gelen bilgi ile update etmeli.

umarım anlatabilmişimdir.

selamlar
adem
 
Örnek dosyanızı eklerseniz daha faydalı olur.
 
Aşağıdaki kodları deneyin.
Kod: 
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [a5]) Is Nothing Then Exit Sub
Dim s1, s2 As Worksheet
Dim Sayisi As Integer
Set s1 = Sheets("Sayfa1")
Set s2 = Sheets("Sayfa2")
Dim SonSatir As Long
SonSatir = s2.Range("A" & Rows.Count).End(xlUp).Row + 1
Sayisi = WorksheetFunction.CountIf(s2.Columns(2), s1.Range("A2"))
If s1.Range("A1") = Empty And s1.Range("A2") = Empty And s1.Range("A3") = Empty And s1.Range("A4") = Empty And s1.Range("A5") = Empty Then
    MsgBox "Değerleri tam giriniz...", vbInformation, "ASKM"
ElseIf Sayisi <= 1 Then
        s2.Cells(SonSatir, 1).Value = s1.Range("A1").Value
        s2.Cells(SonSatir, 2).Value = s1.Range("A2").Value
        s2.Cells(SonSatir, 3).Value = s1.Range("A3").Value
        s2.Cells(SonSatir, 4).Value = s1.Range("A4").Value
        s2.Cells(SonSatir, 5).Value = s1.Range("A5").Value
Else
        Satir = s2.Columns("B").Find(What:=s1.Range("A2").Value).Row
    
        s2.Cells(Satir, 1).Value = s1.Range("A1").Value
        s2.Cells(Satir, 2).Value = s1.Range("A2").Value
        s2.Cells(Satir, 3).Value = s1.Range("A3").Value
        s2.Cells(Satir, 4).Value = s1.Range("A4").Value
        s2.Cells(Satir, 5).Value = s1.Range("A5").Value
        s2.Cells(Satir, 6).Value = Format(Now, "dd.mm.yyyy h:mm;@")
    
End If
MsgBox "Kayıt girildi...", vbInformation, "ASKM"
End Sub
 
müthiş olmuş üstad ,

ufak bir ayrıntı sadece sayfa1 a2 hücresinin eşleşmesi gerekiyordu , burda a3 üde istiyor ve eşleştirirse değiştiriyor hücreyi yoksa yeni bir satıra yazıyor bunu nasıl düzeltebilirim.

benm için sadece a2 eşleşmesi yeterli.

ayrıca emeğiniz için çok teşekkürler.

selamlar
adem
 
A1 den A5 e kadar hücrelerin dolu olmasını istedim özellikle. And olan verilerden istediğinizi silebilirsiniz.
 
dediğinizi yaptım ama çözemedim sorunu , yani eğer a2 ve a3 hücresi sayfa 2 b ve c sütünunda kilerle aynı değilse yeni satıra kaydediyor. benim için sadece a2 satırı aynı olması gerekiyor.

ufakk ayrıntılar ama çözemedim açıkcası yardımcı olmanızı rica etsem

iyi akşamlar
adem
 
Sabah bakarım inşallah.
 
Aşağıdaki şekilde deneyin.
Kod: 
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [a5]) Is Nothing Then Exit Sub
Dim s1, s2 As Worksheet
Dim Sayisi As Integer
Set s1 = Sheets("Sayfa1")
Set s2 = Sheets("Sayfa2")
Dim SonSatir As Long
Cells.Interior.Color = xlNone
SonSatir = s2.Range("A" & Rows.Count).End(xlUp).Row + 1
Sayisi = WorksheetFunction.CountIf(s2.Columns(2), s1.Range("A2"))
If s1.Range("A2") = Empty Then
    MsgBox "Değerleri tam giriniz...", vbInformation, "ASKM"
ElseIf Sayisi <= 1 Then
        s2.Cells(SonSatir, 1).Value = s1.Range("A1").Value
        s2.Cells(SonSatir, 2).Value = s1.Range("A2").Value
        s2.Cells(SonSatir, 3).Value = s1.Range("A3").Value
        s2.Cells(SonSatir, 4).Value = s1.Range("A4").Value
        s2.Cells(SonSatir, 5).Value = s1.Range("A5").Value
Else
        Satir = s2.Columns("B").Find(What:=s1.Range("A2").Value).Row
        s2.Select
        s2.Range("A" & Satir & ":F" & Satir).Select
        Selection.Interior.ColorIndex = 6
        s2.Cells(Satir, 1).Value = s1.Range("A1").Value
        s2.Cells(Satir, 2).Value = s1.Range("A2").Value
        s2.Cells(Satir, 3).Value = s1.Range("A3").Value
        s2.Cells(Satir, 4).Value = s1.Range("A4").Value
        s2.Cells(Satir, 5).Value = s1.Range("A5").Value
        s2.Cells(Satir, 6).Value = Format(Now, "dd.mm.yyyy h:mm;@")
    
End If
MsgBox "Kayıt girildi...", vbInformation, "ASKM"
End Sub
 
MERHABA TEKRAR BIRZ UGRAASINCA COZDUM ,

ElseIf Sayisi < 1 Then

KUCUK ESITTIR DEMISIZ KUCUK OLMASI YETERLI GELDI

ILGINIZ ICIN TEKRAR TESEKKURLER USTAT

SELAMLAR
ADEM
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst