• DİKKAT

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

Makroyu birleştirmek..

H

HD1975

Katılım
13 Şubat 2009
Mesajlar
289
Excel Vers. ve Dili
office 2003
Aşağadaki kodları ayrı ayrı yazdıkmı çalışıyıyor ama birleştirdiğim zaman alttaki kısım çalışmıyor..

Saygılar


Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [A2:A65536]) Is Nothing Then Exit Sub
On Error Resume Next
If Target <> "" Then
Range(Cells(Target.Row, "as"), Cells(Target.Row, "ba")) = 0
Cells(Target.Row, "e") = 0
Cells(Target.Row, "g") = 23
Cells(Target.Row, "h") = 1
Cells(Target.Row, "ı") = 160
Cells(Target.Row, "k") = 2
Cells(Target.Row, "l") = 0
Cells(Target.Row, "m") = 0
Cells(Target.Row, "r") = 0
Cells(Target.Row, "s") = 0
Cells(Target.Row, "u") = 0
Cells(Target.Row, "v") = 0
Cells(Target.Row, "w") = 0
Cells(Target.Row, "ac") = 0
Cells(Target.Row, "ad") = 0
Cells(Target.Row, "bb") = -1
Cells(Target.Row, "ae") = 0
Cells(Target.Row, "af") = 0
Cells(Target.Row, "bc") = 0
Cells(Target.Row, "ag") = 0
Cells(Target.Row, "ah") = 0
Cells(Target.Row, "al") = 0
Cells(Target.Row, "am") = 0
Cells(Target.Row, "aq") = 0


If Target.Column = 64 And Target.Row > 1 Then
Set hedef = Sayfa1.Range("b2:b" & Sayfa1.Range("b65536").End(3).Row).Find(Target.Value, , , 1)
If Not hedef Is Nothing Then

Sayfa2.Cells(Target.Row, "b").Value = Sayfa1.Cells(hedef.Row, "a").Value
'Sayfa2.Cells(Target.Row, "c").Value = Format(Date, "dd.mm.yyyy")
'Sayfa2.Cells(Target.Row, "d").Value = "Fiyatı belli değil"
'Sayfa2.Cells(Target.Row, "bl").Value = Sayfa1.Cells(hedef.Row, "B").Value
Sayfa2.Cells(Target.Row, "bm").Value = Sayfa1.Cells(hedef.Row, "c").Value

End If
End If
End If
End Sub
 
Merhaba,
Kodunuzu aşağıdaki ile değiştirin:
Kod: 
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Target = "" Then Exit Sub
If Not Intersect(Target, [A2:A65536]) Is Nothing Then
Range(Cells(Target.Row, "as"), Cells(Target.Row, "ba")) = 0
Cells(Target.Row, "e") = 0
Cells(Target.Row, "g") = 23
Cells(Target.Row, "h") = 1
Cells(Target.Row, "ı") = 160
Cells(Target.Row, "k") = 2
Cells(Target.Row, "l") = 0
Cells(Target.Row, "m") = 0
Cells(Target.Row, "r") = 0
Cells(Target.Row, "s") = 0
Cells(Target.Row, "u") = 0
Cells(Target.Row, "v") = 0
Cells(Target.Row, "w") = 0
Cells(Target.Row, "ac") = 0
Cells(Target.Row, "ad") = 0
Cells(Target.Row, "bb") = -1
Cells(Target.Row, "ae") = 0
Cells(Target.Row, "af") = 0
Cells(Target.Row, "bc") = 0
Cells(Target.Row, "ag") = 0
Cells(Target.Row, "ah") = 0
Cells(Target.Row, "al") = 0
Cells(Target.Row, "am") = 0
Cells(Target.Row, "aq") = 0
End If

If Target.Column = 64 And Target.Row > 1 Then
Set hedef = Sayfa1.Range("b2:b" & Sayfa1.Range("b65536").End(3).Row).Find(Target.Value, , , 1)
If Not hedef Is Nothing Then
Sayfa2.Cells(Target.Row, "b").Value = Sayfa1.Cells(hedef.Row, "a").Value
'Sayfa2.Cells(Target.Row, "c").Value = Format(Date, "dd.mm.yyyy")
'Sayfa2.Cells(Target.Row, "d").Value = "Fiyatı belli değil"
'Sayfa2.Cells(Target.Row, "bl").Value = Sayfa1.Cells(hedef.Row, "B").Value
Sayfa2.Cells(Target.Row, "bm").Value = Sayfa1.Cells(hedef.Row, "c").Value
End If
End If
End Sub
 
Aşağıdaki gibi denermisiniz.

Kod: 
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Not Intersect(Target, [A2:A65536]) Is Nothing Then
If Target <> "" Then
Range(Cells(Target.Row, "as"), Cells(Target.Row, "ba")) = 0
Cells(Target.Row, "e") = 0
Cells(Target.Row, "g") = 23
Cells(Target.Row, "h") = 1
Cells(Target.Row, "ı") = 160
Cells(Target.Row, "k") = 2
Cells(Target.Row, "l") = 0
Cells(Target.Row, "m") = 0
Cells(Target.Row, "r") = 0
Cells(Target.Row, "s") = 0
Cells(Target.Row, "u") = 0
Cells(Target.Row, "v") = 0
Cells(Target.Row, "w") = 0
Cells(Target.Row, "ac") = 0
Cells(Target.Row, "ad") = 0
Cells(Target.Row, "bb") = -1
Cells(Target.Row, "ae") = 0
Cells(Target.Row, "af") = 0
Cells(Target.Row, "bc") = 0
Cells(Target.Row, "ag") = 0
Cells(Target.Row, "ah") = 0
Cells(Target.Row, "al") = 0
Cells(Target.Row, "am") = 0
Cells(Target.Row, "aq") = 0
End If
ElseIf Target.Column = 64 And Target.Row > 1 Then
Set hedef = Sayfa1.Range("b2:b" & Sayfa1.Range("b65536").End(3).Row).Find(Target.Value, , , 1)
If Not hedef Is Nothing Then
Sayfa2.Cells(Target.Row, "b").Value = Sayfa1.Cells(hedef.Row, "a").Value
'Sayfa2.Cells(Target.Row, "c").Value = Format(Date, "dd.mm.yyyy")
'Sayfa2.Cells(Target.Row, "d").Value = "Fiyatı belli değil"
'Sayfa2.Cells(Target.Row, "bl").Value = Sayfa1.Cells(hedef.Row, "B").Value
Sayfa2.Cells(Target.Row, "bm").Value = Sayfa1.Cells(hedef.Row, "c").Value
End If
End If
End Sub
 
Merhaba ;

Aşağıdaki kısım işlev görmüyor ;

Cells(Target.Row, "e") = 0
Cells(Target.Row, "g") = 23
Cells(Target.Row, "h") = 1
Cells(Target.Row, "ı") = 160
Cells(Target.Row, "k") = 2
Cells(Target.Row, "l") = 0
Cells(Target.Row, "m") = 0
Cells(Target.Row, "r") = 0
Cells(Target.Row, "s") = 0
Cells(Target.Row, "u") = 0
Cells(Target.Row, "v") = 0
Cells(Target.Row, "w") = 0
Cells(Target.Row, "ac") = 0
Cells(Target.Row, "ad") = 0
Cells(Target.Row, "bb") = -1
Cells(Target.Row, "ae") = 0
Cells(Target.Row, "af") = 0
Cells(Target.Row, "bc") = 0
Cells(Target.Row, "ag") = 0
Cells(Target.Row, "ah") = 0
Cells(Target.Row, "al") = 0
Cells(Target.Row, "am") = 0
Cells(Target.Row, "aq") = 0


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