Excel - Vba satır ekleyerek aralık üyeliğini korur

Konu

VBA’da, bir satırı nasıl kopyalar / eklerim (nasıl yerleştiririm) ve kaynak satırın bir sütun aralığının kesişmesi durumunda, yeni satırın da aralıkta olacağını ve aralığın 1 ile (yani eklenen satır) olacağını .

İmleç, bir aralığın en üstünde bir satırın üzerindeyse, yeni satır aralığın bir üyesi olmaz ve aralık bir satır daha büyük olmaz.

xlUp ve xlDown fark yaratmaz ve onları dışarıda bırakmaz (ki bu kesişen sütunlu aralıklar varsa Excel'in yapması gereken en iyi şey olduğunu söyler).

Çözüm

Tamamen otomatik yapıyorum. Aralığa isim vermenize gerek yok. Makro "test" yapar. girmeniz gereken tek giriş, giriş kutusu geldiğinde örneğin 2 veya 3 veya 4 için silinecek satırın numarasını yazmanızdır. Makro "geri al", makroların yaptıklarını geri alır.

Veri tabanı A1'den A5'e böyledir

1

2

3

4

5

sadece "test" makrosunu çalıştırmayın, her iki makronun da modülde kopyalanması gerekir). Üzgünüm bu kıvrımlı bir makro oldu. "Resize" kullanmaya çalıştım. Bir şekilde ya da diğer ben başaramadım. Belki bazı uzmanlar daha iyi bir çözüm sağlayabilir. Ancak bu çözüm işe yarıyor. Eğer adlandırılmış aralığın menzili farklıysa, bu ifadeyi "test" makrosunda size uygun olacak şekilde değiştirin.

Aralık ("A2: a4"). Name = "myrange"

Makrolar:

Makro 1

 Alt test ()
Dim r Aralık olarak, j Tam sayı olarak, k Tam sayı olarak, m Tam sayı olarak
geri alma
Aralık ("A2: a4"). Name = "myrange"
Set r = Range ("myrange")
m = WorksheetFunction.Count (r)
'MsgBox m
k = InputBox ("seçilecek satırın numarasını yazın")
Sıralar (k) .Select
Set r = Range ("myrange")
j = Range ("myrange") Hücreler (1, 1) .Row
'MsgBox j
Selection.Rows.Insert
Selection.Row = j ise Öyleyse
ActiveWorkbook.Names ( "MyRange"). Delete
Aralık (Hücreler (Seçim. Sıra "A"), r Hücreler (m, 1). Name = "myrange"
Bittiğinde
MsgBox Aralığı ("myrange"). Adres
Son Alt 

Makro 2

 Alt geri al ()
Dim R Menzilli, c Menzilli
R = Range (Aralık ("A1"), Hücreler (Rows.Count, "A"). End (xlUp))
Her c için r
Eğer c = "" Öyleyse c.EntireRow.Delete
Sonraki c
Son Alt 

Not

Bu bahşiş için venkat1926'ya teşekkürler