• DİKKAT

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

HÜCREDEKİ FORMÜL BOZULMASIN

O

Ongun

Katılım
24 Mayıs 2005
Mesajlar
462
Excel Vers. ve Dili
Excel 2003 Türkçe
Arkadaşlar, çalışmalarınızda başarılar dilerim. Aşağıdaki kodların açıklaması, eğer hücreler eşit ise belirlenen hücre bilgilerini aktar.

Sorum şöyle;
1- Aktarılan hücre aralığında =TOPLA förmülü var, bu formülün bozulmasını istemiyorum. Bunun için kodlarda nasıl bir düzenleme yapabilirim.

2- Kırmızı ile belirlenen kodda aktarma yapmıyor. Acaba If Then sayısı fazla olduğu için olabilirmi.

Saygılarımla. :hey:

For c = 5 To 23
If Cells(2, 2) = Cells(2, 20) Then Cells(c, 2) = Cells(c, 17): Cells(c, 3) = Cells(c, 18): Cells(c, 4) = Cells(c, 19)
If Cells(2, 2) = Cells(2, 23) Then Cells(c, 2) = Cells(c, 20): Cells(c, 3) = Cells(c, 21): Cells(c, 4) = Cells(c, 22)
If Cells(2, 2) = Cells(2, 26) Then Cells(c, 2) = Cells(c, 23): Cells(c, 3) = Cells(c, 24): Cells(c, 4) = Cells(c, 25)
If Cells(2, 2) = Cells(2, 29) Then Cells(c, 2) = Cells(c, 26): Cells(c, 3) = Cells(c, 27): Cells(c, 4) = Cells(c, 28)
If Cells(2, 2) = Cells(2, 32) Then Cells(c, 2) = Cells(c, 29): Cells(c, 3) = Cells(c, 30): Cells(c, 4) = Cells(c, 31)
If Cells(2, 2) = Cells(2, 35) Then Cells(c, 2) = Cells(c, 32): Cells(c, 3) = Cells(c, 33): Cells(c, 4) = Cells(c, 34)
If Cells(2, 2) = Cells(2, 38) Then Cells(c, 2) = Cells(c, 35): Cells(c, 3) = Cells(c, 36): Cells(c, 4) = Cells(c, 37)
If Cells(2, 2) = Cells(2, 41) Then Cells(c, 2) = Cells(c, 38): Cells(c, 3) = Cells(c, 39): Cells(c, 4) = Cells(c, 40)
If Cells(2, 2) = Cells(2, 44) Then Cells(c, 2) = Cells(c, 41): Cells(c, 3) = Cells(c, 42): Cells(c, 4) = Cells(c, 43)
If Cells(2, 2) = Cells(2, 47) Then Cells(c, 2) = Cells(c, 44): Cells(c, 3) = Cells(c, 45): Cells(c, 4) = Cells(c, 46)
If Cells(2, 2) = Cells(2, 50) Then Cells(c, 2) = Cells(c, 47): Cells(c, 3) = Cells(c, 48): Cells(c, 4) = Cells(c, 49)
If Cells(2, 2) = Cells(2, 53) Then Cells(c, 2) = Cells(c, 50): Cells(c, 3) = Cells(c, 51): Cells(c, 4) = Cells(c, 52)If Cells(2, 2) = Cells(2, 56) Then Cells(c, 2) = Cells(c, 53): Cells(c, 3) = Cells(c, 54): Cells(c, 4) = Cells(c, 55)
If Cells(2, 2) = Cells(2, 59) Then Cells(c, 2) = Cells(c, 56): Cells(c, 3) = Cells(c, 57): Cells(c, 4) = Cells(c, 58)
If Cells(2, 2) = Cells(2, 62) Then Cells(c, 2) = Cells(c, 59): Cells(c, 3) = Cells(c, 60): Cells(c, 4) = Cells(c, 61)
If Cells(2, 2) = Cells(2, 65) Then Cells(c, 2) = Cells(c, 62): Cells(c, 3) = Cells(c, 63): Cells(c, 4) = Cells(c, 64)
If Cells(2, 2) = Cells(2, 68) Then Cells(c, 2) = Cells(c, 65): Cells(c, 3) = Cells(c, 66): Cells(c, 4) = Cells(c, 67)
If Cells(2, 2) = Cells(2, 71) Then Cells(c, 2) = Cells(c, 68): Cells(c, 3) = Cells(c, 69): Cells(c, 4) = Cells(c, 70)
If Cells(2, 2) = Cells(2, 74) Then Cells(c, 2) = Cells(c, 71): Cells(c, 3) = Cells(c, 72): Cells(c, 4) = Cells(c, 73)
If Cells(2, 2) = Cells(2, 77) Then Cells(c, 2) = Cells(c, 74): Cells(c, 3) = Cells(c, 75): Cells(c, 4) = Cells(c, 76)
If Cells(2, 2) = Cells(2, 80) Then Cells(c, 2) = Cells(c, 77): Cells(c, 3) = Cells(c, 78): Cells(c, 4) = Cells(c, 79)
If Cells(2, 2) = Cells(2, 83) Then Cells(c, 2) = Cells(c, 80): Cells(c, 3) = Cells(c, 81): Cells(c, 4) = Cells(c, 82)
If Cells(2, 2) = Cells(2, 86) Then Cells(c, 2) = Cells(c, 83): Cells(c, 3) = Cells(c, 84): Cells(c, 4) = Cells(c, 85)
If Cells(2, 2) = Cells(2, 89) Then Cells(c, 2) = Cells(c, 86): Cells(c, 3) = Cells(c, 87): Cells(c, 4) = Cells(c, 88)
If Cells(2, 2) = Cells(2, 92) Then Cells(c, 2) = Cells(c, 89): Cells(c, 3) = Cells(c, 90): Cells(c, 4) = Cells(c, 91)
If Cells(2, 2) = Cells(2, 95) Then Cells(c, 2) = Cells(c, 92): Cells(c, 3) = Cells(c, 93): Cells(c, 4) = Cells(c, 94)
If Cells(2, 2) = Cells(2, 98) Then Cells(c, 2) = Cells(c, 95): Cells(c, 3) = Cells(c, 96): Cells(c, 4) = Cells(c, 97)
If Cells(2, 2) = Cells(2, 101) Then Cells(c, 2) = Cells(c, 98): Cells(c, 3) = Cells(c, 99): Cells(c, 4) = Cells(c, 100)
If Cells(2, 2) = Cells(2, 104) Then Cells(c, 2) = Cells(c, 101): Cells(c, 3) = Cells(c, 102): Cells(c, 4) = Cells(c, 103)
If Cells(2, 2) = Cells(2, 107) Then Cells(c, 2) = Cells(c, 104): Cells(c, 3) = Cells(c, 105): Cells(c, 4) = Cells(c, 106)
If Cells(2, 2) = Cells(2, 110) Then Cells(c, 2) = Cells(c, 107): Cells(c, 3) = Cells(c, 108): Cells(c, 4) = Cells(c, 109)
If Cells(2, 2) = Cells(2, 113) Then Cells(c, 2) = Cells(c, 110): Cells(c, 3) = Cells(c, 111): Cells(c, 4) = Cells(c, 112)
If Cells(2, 2) = Cells(2, 116) Then Cells(c, 2) = Cells(c, 113): Cells(c, 3) = Cells(c, 114): Cells(c, 4) = Cells(c, 115)
If Cells(2, 2) = Cells(2, 119) Then Cells(c, 2) = Cells(c, 116): Cells(c, 3) = Cells(c, 117): Cells(c, 4) = Cells(c, 118)
If Cells(2, 2) = Cells(2, 122) Then Cells(c, 2) = Cells(c, 119): Cells(c, 3) = Cells(c, 120): Cells(c, 4) = Cells(c, 121)
Next c
 
Arkadaşlar örnek dosya gönderiyorum.

Lütfen yardım edermisiniz. Saygılarımla.
 
Sayın Ongun Bey, anladığım kadarıyla, basit bir mantıkla sorununuzu haledebilirsiniz. Siz bir şekilde aktarma yapıyorsunuz. Yada bir Delete işlemi yapıyorsunuz. Bırakın formül bozulsun. O işlemi yaptığınız kod bloğunun en sonuna, "Makro Kaydet" ile =TOPLA() formülünün kod biçimi ni hazırlayıp, kod bloğunun son satırına ilave edin. Bir deneyin...
 
Örneğinizden anladığım kadarıyla bazı satırlarda atlatma yapmak için aşağıdaki şekilde kullanabilirsiniz.
[vb:1:76e6917042]Private Sub CommandButton1_Click()

For c = 3 To 20
If c = 10 Or c = 16 Or c = 17 Then GoTo atla
If Cells(1, 1) = Cells(1, 2) Then
Cells(c, 1) = Cells(c, 5): Cells(c, 2) = Cells(c, 6): Cells(c, 3) = Cells(c, 7)
End If
atla:
Next c

End Sub[/vb:1:76e6917042]

İlk mesajınızda yazdıklarınızdan anladığım kadarıyla kodlarınızı kısaltmak için
[vb:1:76e6917042]Sub dene()
a = Cells(2, 2)
t = 0
For t = 20 To 122 Step 3
If a = Cells(2, t) Then
Cells(2, t).Font.Bold = True
sut = t - 3
Exit For
End If
Next t

If t > 0 Then
For c = 5 To 23
Sayfa1.Range(Cells(c, 2), Cells(c, 4)) = Sayfa1.Range(Cells(c, sut), Cells(c, sut + 3)).Value
Next c
End If
End Sub[/vb:1:76e6917042] şeklinde kullanabilirsiniz. Yine atlatma yapmak için c yi kontrol ettirerek atlama yapabilirsiniz.
 
Sayın Seyit Tiken, çok haklısınız, ben bunu nasıl düşünemedim. :kafa: kodları aşağıdaki gibi düzenledim sorun çözüldü. Çok teşekkür ederim. Saygılarımla :ok::

Private Sub CommandButton1_Click()
Range("A3:C9").ClearContents
Range("A11:C15").ClearContents
Range("A18:C20").ClearContents
For c = 3 To 21
If Cells(1, 1) = Cells(1, 2) Then
Cells(c, 1) = Cells(c, 5): Cells(c, 2) = Cells(c, 6): Cells(c, 3) = Cells(c, 7)
End If
Next c
Range("A10,B10,C10").FormulaR1C1 = "=SUM(R[-7]C:R[-1]C)"
Range("A16,B16,C16").FormulaR1C1 = "=SUM(R[-5]C:R[-1]C)"
Range("A17,B17,C17").FormulaR1C1 = "=SUM(R[-7]C+R[-1]C)"
Range("A21,B21,C21").FormulaR1C1 = "=SUM(R[-2]C:R[-1]C)"
End Sub
 
Sayın veyselemre, Kodlar üzerinde deneme yaptım, bir problem varsa size bildireyim düşüncesiyle kusura bakmayın verdiğiniz cevap için teşekkürü geciktirdim. Elinize yüreğinize sağlık çok teşekkür ederim. Tam istediğim gibi :mutlu:

Saygılarımla. :dua:
 
veyselemre' Alıntı:
İlk mesajınızda yazdıklarınızdan anladığım kadarıyla kodlarınızı kısaltmak için
[vb:1:c0c7a5023c]Sub dene()
a = Cells(2, 2)
t = 0
For t = 20 To 122 Step 3
If a = Cells(2, t) Then
Cells(2, t).Font.Bold = True
sut = t - 3
Exit For
End If
Next t

If t > 0 Then
For c = 5 To 23
Sayfa1.Range(Cells(c, 2), Cells(c, 4)) = Sayfa1.Range(Cells(c, sut), Cells(c, sut + 3)).Value
Next c
End If
End Sub[/vb:1:c0c7a5023c] şeklinde kullanabilirsiniz. Yine atlatma yapmak için c yi kontrol ettirerek atlama yapabilirsiniz.
Genişletmek için tıkla ...

Sayın veyselemre, yukarıda verdiğiniz kodları kullanıyorum. Ancak, ekli dosyada da göreceğiniz gibi 2006 OCAK ve 2007 OCAK dönemlerini seçtiğimde hata veriyor. Bu konuda yardımcı olabilirmisiniz.

Örnek dosya ektedir.
 
Kodlarınızın şu şekilde değiştirin, ayrıca 2.satırdaki 2006 OCAK Yazısında boşluklar var, o nedenle combobox taki eşleşmediğinden hata veriyor.
[vb:1:dce24d202a]Private Sub ComboBox1_Change()
[b2] = ComboBox1.Value
a = Cells(2, 2)
T = 0
For T = 17 To 86 Step 3
If a = Cells(2, T) Then
sut = T
Exit For
End If
Next T
If T > 0 Then
For c = 5 To 22
Sayfa1.Range(Cells(c, 2), Cells(c, 4)) = Sayfa1.Range(Cells(c, sut), Cells(c, sut + 2)).Value
Next c
End If
Range("B12,C12,D12").FormulaR1C1 = "=SUM(R[-7]C:R[-1]C)"
Range("B18,C18,D18").FormulaR1C1 = "=SUM(R[-5]C:R[-1]C)"
Range("B19,C19,D19").FormulaR1C1 = "=SUM(R[-7]C+R[-1]C)"
End Sub[/vb:1:dce24d202a]
 
Sayın veyselemre, kodlarınızı denedim, ancak yine hata veriyor.

Sorun sadece 2006 OCAK ve 2007 OCAK dönemlerinde. :kafa:
 
veyselemre' Alıntı:
Kodlarınızın şu şekilde değiştirin, ayrıca 2.satırdaki 2006 OCAK Yazısında boşluklar var, o nedenle combobox taki eşleşmediğinden hata veriyor.
Genişletmek için tıkla ...
Mesajımı iyi okumadınız anlaşılan, 2 satırdaki "2006 OCAK" ve "2007 OCAK" metinlerini yeniden yazın deneyin, çünkü "OCAK"tan sonra boşluklar var bu yüzden combobox taki verilerle eşleşmiyor.
 
veyselemre' Alıntı:
çünkü "OCAK"tan sonra boşluklar var bu yüzden combobox taki verilerle eşleşmiyor.
Genişletmek için tıkla ...

Sayın veyselemre, evet şimdi düzeldi. Haklısınız gerçekten boşluk varmış, ben boşluk diyince 2006 ile OCAK arasında sandım. Çok özür dilerim.

Verdiğiniz bilgilerden dolayı çok teşekkür ederim. Elinize yüreğinize sağlık. Saygılarımla. :dua:
 
Rica ederim, çalışmalarınızda başarılar dilerim.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst