- Katılım
- 3 Mart 2009
- Mesajlar
- 519
- Excel Vers. ve Dili
- excel 2003 tr
Hücre biçimlendirme sorunu (formüllü)
tüm formu gezdim bu iki makroya ulaştım ancak benim istediğim ayır bir sayfadanki verileri alırken sürekli güncellemesi başvuru yapılan sayfa değişince başvuruyu alan hücrede değişmeli ve bunu birinci de olmna makrodaki gibi yanındanki sayılar olmadan yapmalı şimdiden teşekürler
----------------------------------------------
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo son
If Not Intersect(Target, [c4:c65536]) Is Nothing Then
Set Aralik = Range("h4:h" & [g65536].End(3).Row)
Set Bul = Aralik.Find(Target.Row, lookat:=xlWhole, LookIn:=xlValues)
If Not Bul Is Nothing Then
Adres = Bul.Address
Do
Target.Copy Cells(Bul.Row, Bul.Column - 1)
Set Bul = Aralik.FindNext(Bul)
Loop While Not Bul Is Nothing And Bul.Address <> Adres
End If
ElseIf Not Intersect(Target, [h4:h65536]) Is Nothing Then
Range("c" & Target).Copy Target.Offset(0, -1)
End If
son:
End Sub
-------------------------------------
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Sayfa As String, Hücre As String
If Target.HasFormula Then
If InStr(1, Target.Formula, "!") > 0 Then
Sayfa = Split(Replace(Target.Formula, "=", ""), "!")(0)
Hücre = Split(Replace(Target.Formula, "=", ""), "!")(1)
Worksheets(Sayfa).Range(Hücre).Copy Target
ElseIf InStr(1, Target.Formula, "=") > 0 Then
Hücre = Replace(Target.Formula, "=", "")
Range(Hücre).Copy Target
End If
End If
End Sub
--------------------------
tüm formu gezdim bu iki makroya ulaştım ancak benim istediğim ayır bir sayfadanki verileri alırken sürekli güncellemesi başvuru yapılan sayfa değişince başvuruyu alan hücrede değişmeli ve bunu birinci de olmna makrodaki gibi yanındanki sayılar olmadan yapmalı şimdiden teşekürler
----------------------------------------------
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo son
If Not Intersect(Target, [c4:c65536]) Is Nothing Then
Set Aralik = Range("h4:h" & [g65536].End(3).Row)
Set Bul = Aralik.Find(Target.Row, lookat:=xlWhole, LookIn:=xlValues)
If Not Bul Is Nothing Then
Adres = Bul.Address
Do
Target.Copy Cells(Bul.Row, Bul.Column - 1)
Set Bul = Aralik.FindNext(Bul)
Loop While Not Bul Is Nothing And Bul.Address <> Adres
End If
ElseIf Not Intersect(Target, [h4:h65536]) Is Nothing Then
Range("c" & Target).Copy Target.Offset(0, -1)
End If
son:
End Sub
-------------------------------------
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Sayfa As String, Hücre As String
If Target.HasFormula Then
If InStr(1, Target.Formula, "!") > 0 Then
Sayfa = Split(Replace(Target.Formula, "=", ""), "!")(0)
Hücre = Split(Replace(Target.Formula, "=", ""), "!")(1)
Worksheets(Sayfa).Range(Hücre).Copy Target
ElseIf InStr(1, Target.Formula, "=") > 0 Then
Hücre = Replace(Target.Formula, "=", "")
Range(Hücre).Copy Target
End If
End If
End Sub
--------------------------
Ekli dosyalar
Son düzenleme:
