By Jeffw 18 Aralık 2022 Pazar günü
Yayınlanan Kutools for Excel
Cevaplar 2
Seviyor 0
Görünümler 4.8K
Oy 0
Hücreden verileri aynı satır farklı sütuna kopyalamak için VBA'yı kopyaladım ve değiştirdim, böylece F Sütunundaki bir hücreyi değiştirebilir ve değeri E sütununa kaydedebilirim, ancak denediğimde hiçbir şey olmuyor. Birisi bana neyi yanlış yaptığımı söyleyebilir mi? Ayrıca değişikliği yaptığımda G sütununa bir tarih damgası yerleştirmek istiyorum.

Sütun I'deki bir hücreyi Sütun H'ye kaydetmek ve Sütun J'de değişen tarih damgasını değiştirmek için değiştirdiğimde de aynı şeyi yapabilmeyi umuyordum.

Herhangi bir yardım büyük ölçüde onaylanabilir.


Aralık olarak Dim xRg
xChangeRg'yi Aralık Olarak Karart
xDependRg'yi Aralık Olarak Karart
Dim xDic Yeni Sözlük Olarak
Özel Alt Çalışma Alanı_Değiştir (ByVal Target As Range)
Dim kadar uzun
Aralık olarak xCell Dim
Aralık Olarak xDCell'i Karart
xHeader'ı Dize Olarak Karart
xCommText'i Dize Olarak Kısma
On Error Resume Next
Application.ScreenUpdating = Yanlış
Application.EnableEvents = Yanlış
xHeader = "Önceki değer :"
x = xDic.Keys
I = 0 için UBound(xDic.Keys) için
xCell = Range(xDic.Keys(I)) ayarla
xDCell'i ayarlayın = Cells(xCell.Row, 5)
xDCell.Value = ""
xDCell.Value = xDic.Items(I)
Sonraki
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Özel Alt Çalışma Sayfası_SelectionChange (ByVal Target As Range)
Dim I, J Kadar Uzun
xRgArea'yı Aralık Olarak Karart
Etikete Git1 Hatasında
Target.Count > 1 ise Sub Exit
Application.EnableEvents = Yanlış
xDependRg = Target.Dependents olarak ayarlayın
xDependRg Hiçbir Şey Değilse, Etikete Git1
xDependRg Değilse, O Zaman Hiçbir Şey Değildir
xDependRg = Intersect(xDependRg, Range("F:F")) olarak ayarlayın
Eğer son
Etiket1:
xRg = Intersect(Hedef, Menzil("F:F")) ayarla
(xRg Değil Hiçbir Şey Değil) Ve (xDependRg Değil Hiçbir Şey Değilse) O Zaman
xChangeRg = Union(xRg, xDependRg) olarak ayarlayın
ElseIf (xRg Is Nothing) Ve (xDependRg Is Nothing) O zaman
xChangeRg'yi = xDependRg olarak ayarlayın
ElseIf (xRg Değil Hiçbir Şeydir) Ve (xDependRg Hiçbir Şey Değildir) Sonra
xChangeRg'yi = xRg'ye ayarlayın
başka
Application.EnableEvents = True
Exit Sub
Eğer son
xDic.RemoveAll
I = 1 için xChangeRg.Areas.Count'a
xRgArea = xChangeRg.Areas(I) olarak ayarlayın
J = 1 için xRgArea.Count'a
xDic.Add xRgArea(J).Adres, xRgArea(J).Formül
Sonraki
Sonraki
xChangeRg'yi Ayarla = Hiçbir Şey
xRg = Hiçbir şey olarak ayarla
xDependRg = Hiçbir şey ayarla
Application.EnableEvents = True
End Sub
GÜNCELLEME

VBA çalışıyor! Lütfen aşağıdaki koda bakın. Sütun I'deki bir hücreyi değiştirdiğimde değeri Sütun H'ye kaydetmesi için değiştirme konusunda yardıma ihtiyacım var.


Aralık olarak Dim xRg
xChangeRg'yi Aralık Olarak Karart
xDependRg'yi Aralık Olarak Karart
Dim xDic Yeni Sözlük Olarak
Özel Alt Çalışma Alanı_Değiştir (ByVal Target As Range)
Dim kadar uzun
Aralık olarak xCell Dim
Aralık Olarak xDCell'i Karart
xHeader'ı Dize Olarak Karart
xCommText'i Dize Olarak Kısma
On Error Resume Next
Application.ScreenUpdating = Yanlış
Application.EnableEvents = Yanlış
xHeader = "Önceki değer :"
x = xDic.Keys
I = 0 için UBound(xDic.Keys) için
xCell = Range(xDic.Keys(I)) ayarla
xDCell'i ayarlayın = Cells(xCell.Row, 5)
xDCell.Value = ""
xDCell.Value = xDic.Items(I)
Sonraki

Target.Column = 6 ise
Application.EnableEvents = Yanlış
Hücreler(Hedef.Satır, 7).Değer = Tarih
Application.EnableEvents = True
Eğer son

Target.Column = 9 ise
Application.EnableEvents = Yanlış
Hücreler(Hedef.Satır, 10).Değer = Tarih
Application.EnableEvents = True
Eğer son
Application.EnableEvents = True
End Sub
Özel Alt Çalışma Sayfası_SelectionChange (ByVal Target As Range)
Dim I, J Kadar Uzun
xRgArea'yı Aralık Olarak Karart
Etikete Git1 Hatasında
Target.Count > 1 ise Sub Exit
Application.EnableEvents = Yanlış
xDependRg = Target.Dependents olarak ayarlayın
xDependRg Hiçbir Şey Değilse, Etikete Git1
xDependRg Değilse, O Zaman Hiçbir Şey Değildir
xDependRg = Intersect(xDependRg, Range("F:F")) olarak ayarlayın
Eğer son
Etiket1:
xRg = Intersect(Hedef, Menzil("F:F")) ayarla
(xRg Değil Hiçbir Şey Değil) Ve (xDependRg Değil Hiçbir Şey Değilse) O Zaman
xChangeRg = Union(xRg, xDependRg) olarak ayarlayın
ElseIf (xRg Is Nothing) Ve (xDependRg Is Nothing) O zaman
xChangeRg'yi = xDependRg olarak ayarlayın
ElseIf (xRg Değil Hiçbir Şeydir) Ve (xDependRg Hiçbir Şey Değildir) Sonra
xChangeRg'yi = xRg'ye ayarlayın
başka
Application.EnableEvents = True
Exit Sub
Eğer son
xDic.RemoveAll
I = 1 için xChangeRg.Areas.Count'a
xRgArea = xChangeRg.Areas(I) olarak ayarlayın
J = 1 için xRgArea.Count'a
xDic.Add xRgArea(J).Adres, xRgArea(J).Formül
Sonraki
Sonraki
xChangeRg'yi Ayarla = Hiçbir Şey
xRg = Hiçbir şey olarak ayarla
xDependRg = Hiçbir şey ayarla

Application.EnableEvents = True
End Sub
·
1 yıl önce
·
0 Beğeni
·
0 Oy
·
0 Yorumlar
·
Sadece açıklığa kavuşturmak için, bu zaten yaptıklarına ek olacaktır. Hem F sütununda hem de I sütununda yapılan değişiklikleri takip edebilmek istiyorum. Karışıklık için özür dilerim.
·
1 yıl önce
·
0 Beğeni
·
0 Oy
·
0 Yorumlar
·
Yazının Tamamını Görüntüle