• DİKKAT

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

hücre de bulunan yazı formatları değişmeden formülle taşımak

  • Konbuyu başlatan Konbuyu başlatan ikikan
  • Başlangıç tarihi Başlangıç tarihi
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
--------------------------
 

Ekli dosyalar

Son düzenleme:
Selamlar,

İstediğiniz şekilde dinamik formülle biçimlendirme işlemi yapamazsınız. Makro ile yapabilirsiniz. Zaten bunlarında örneklerine ulaşmışsınız.
 
Selamlar,

İstediğiniz şekilde dinamik formülle biçimlendirme işlemi yapamazsınız. Makro ile yapabilirsiniz. Zaten bunlarında örneklerine ulaşmışsınız.

korhan bey aslında benim istediğim formülün içini biçimlendirmek örnek olarak

=ELEMAN($AV$7;
"0.2- Tip";
"0.2- Tip ve ticari açıklama (açıklamalar)";
"0.2- Tipi ve ticari tanımı (tanımları)";
"0.2- Tipi ";
"0.2- Tipi ";
"0.2- Tipi ve genel ticari açıklaması";
"0.2- Tipi ";
"0.2- Tipi ";
"0.2- Tipi ";
"0.2- Tipi ";
"0.2. Tip ve genel ticari tanımı/tanımları ";
"0.2- Tipi ve genel ticari tanımı/tanımları";
"Yanlışbir Değer Girdin 1 ile 11 Arasında bir Değer Girin")

formülünde parantez içinde olan yerleri üst simge yapmak üsteki makroya ek olarak ...
 
Selamlar,

Formül içinde kullandığınız AV7 hücresi elle değişen bir hücre mi, yoksa formüllemi hesaplanıyor?

Makro ile işlem yapılacaksa eleman formülü kullanmanıza gerek yok. Makro ile istediğiniz bilgi istediğiniz formatta hücreye aktarılabilir.
 
Selamlar,

Formül içinde kullandığınız AV7 hücresi elle değişen bir hücre mi, yoksa formüllemi hesaplanıyor?

Makro ile işlem yapılacaksa eleman formülü kullanmanıza gerek yok. Makro ile istediğiniz bilgi istediğiniz formatta hücreye aktarılabilir.

elle degişiyor onda sorunum yok yanlıs formül içinde üst simge yaptıgımda ve daha önce gönderdigim makroyu birleştirdigimde 1 sayfadaki verileri 2 sayfaya sitil ve hücre biçimini bozmadan geçmesini saglıyamadım
 

Ekli dosyalar

Selamlar,

Formül içinde kullandığınız AV7 hücresi elle değişen bir hücre mi, yoksa formüllemi hesaplanıyor?

Makro ile işlem yapılacaksa eleman formülü kullanmanıza gerek yok. Makro ile istediğiniz bilgi istediğiniz formatta hücreye aktarılabilir.

peki korhan bey aşadaki makroyu thisworkbooks göre ayarlamamız ve ayrıca numaraya göre degilde sütundaki tüm verilere uygulatmak mümkünmüdür ...

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
 
Selamlar,

Kodu uyarlamak sorun değil. Fakat bu kod sizin istediğiniz şekilde çalışmayacaktır. Karmaşık formüllerle başvurular oluşturursanız kodu her seferinde bu başvurulara göre düzenlemek gerekecektir.

Siz örnek dosya üzerinde hangi verileri hangi biçimde ve koşulda nereye aktarmak istediğinizi belirtin ona göre kod hazırlayalım.
 
Geri
Üst