Note: The other languages of the website are Google-translated. Back to English

Excel'de hücre değerine göre otomatik satır nasıl eklenir?

doc-insert-satıra dayalı-değeri-1
Bir dizi veriniz olduğunu ve Excel'de belirli bir değerin üstüne veya altına otomatik olarak boş satırlar eklemek istediğinizi varsayalım, örneğin, aşağıda gösterilen ekran görüntüsü gibi sıfır değerinin altındaki satırları otomatik olarak ekleyin. Excel'de, bu görevi çözmenin doğrudan bir yolu yoktur, ancak Excel'de belirli bir değere göre otomatik olarak satır eklemeniz için bir Makro kodu sunabilirim.
VBA ile hücre değerine göre aşağıdaki satırı ekleyin

Kutools for Excel ile hücre değerine dayalı olarak yukarıya satır ekleyin iyi fikir3

VBA çalıştırarak hücre değerine dayalı satır eklemek için lütfen aşağıdaki adımları uygulayın:

1. Basın Alt + F11 aynı anda tuşlar ve Uygulamalar için Microsoft Visual Basic pencere açılır.

2. tık Ekle > modül, ardından popping'e VBA kodunun altına yapıştırın modül pencere.

VBA: Hücre değerine göre aşağıdaki satırı ekleyin.

Sub BlankLine()
	'Updateby20150203
	Dim Rng As Range
	Dim WorkRng As Range
	On Error Resume Next
	xTitleId                   = "KutoolsforExcel"
	Set WorkRng                = Application.Selection
	Set WorkRng                = Application.InputBox("Range", xTitleId, WorkRng.Address, Type: = 8)
	Set WorkRng                = WorkRng.Columns(1)
	xLastRow                   = WorkRng.Rows.Count
	Application.ScreenUpdating = False
	For xRowIndex = xLastRow To 1 Step - 1
		Set Rng                   = WorkRng.Range("A" & xRowIndex)
		If Rng.Value = "0" Then
			Rng.Offset(1, 0).EntireRow.Insert Shift: = xlDown
		End If
	Next
	Application.ScreenUpdating = True
End Sub

3. tık F5 tuşu veya koşmak düğmesi, bir iletişim kutusu açılır ve sütun sıfır içerir'i seçin. Ekran görüntüsüne bakın:
doc-insert-satıra dayalı-değeri-2

4. tık OK. Ardından sıfır değerinin altına boş satırlar eklenecektir.
doc-insert-satıra dayalı-değeri-3

Bahşiş:

1. Diğer değere göre satır eklemek isterseniz, 0 VBA'da istediğiniz herhangi bir değere: Rng.Value = "0" ise.

2. Sıfırın veya başka bir değerin üzerinde satırlar eklemek isterseniz, aşağıdaki vba kodunu kullanabilirsiniz.

VBA: Sıfır değerinin üzerine satır ekle:

Sub BlankLine()
	'Updateby20150203
	Dim Rng As Range
	Dim WorkRng As Range
	On Error Resume Next
	xTitleId                   = "KutoolsforExcel"
	Set WorkRng                = Application.Selection
	Set WorkRng                = Application.InputBox("Range", xTitleId, WorkRng.Address, Type: = 8)
	Set WorkRng                = WorkRng.Columns(1)
	xLastRow                   = WorkRng.Rows.Count
	Application.ScreenUpdating = False
	For xRowIndex = xLastRow To 1 Step - 1
		Set Rng                   = WorkRng.Range("A" & xRowIndex)
		If Rng.Value = "0" Then
			Rng.EntireRow.Insert Shift: = xlDown
		End If
	Next
	Application.ScreenUpdating = True
End Sub

doc-insert-satıra dayalı-değeri-4


VBA'ya aşina değilseniz deneyebilirsiniz. Kutools for Excel's Belirli Hücreleri Seçin yardımcı program ve ardından yukarıya satırlar ekleyin.

Kutools for Excel, ile daha fazla 300 kullanışlı fonksiyonlar, işlerinizi daha kolay hale getirir. 

Kurduktan sonra Kutools for Excel, lütfen aşağıdaki işlemleri yapın:(Şimdi Excel için Kutools'u Ücretsiz İndirin!)

1. Belirli hücreleri bulmak istediğiniz listeyi seçin ve tıklayın. Kutools > seçmek > Belirli Hücreleri Seçin. Ekran görüntüsüne bakın:
doc değeri 9'a göre satır ekle

2. Açılan iletişim kutusunda kontrol edin Tüm satır seçeneğini seçin ve ardından seçime gidin eşittir itibaren Belirli tür listeye girin ve ardından bulmak istediğiniz değeri sağdaki metin kutusuna girin. Ekran görüntüsüne bakın:
doc değeri 6'a göre satır ekle

3. tık Okve seçilen satırların sayısını size hatırlatmak için bir iletişim kutusu açılır, sadece kapatın.

4. İmleci seçilen bir satıra getirin ve seçmek için sağ tıklayın Ekle bağlam menüsünden. Ekran görüntüsüne bakın:
doc değeri 7'a göre satır ekle

Şimdi satırlar belirli bir değere göre yukarıya eklenir.
doc değeri 8'a göre satır ekle


İlgili Makaleler:


En İyi Ofis Üretkenliği Araçları

Kutools for Excel Sorunlarınızın Çoğunu Çözer ve Verimliliğinizi% 80 Artırır

  • Yeniden: Hızlıca yerleştirin karmaşık formüller, grafikler ve daha önce kullandığınız her şey; Hücreleri Şifrele şifre ile; Posta Listesi Oluşturun ve e-posta gönder ...
  • Süper Formül Çubuğu (birden çok metin ve formül satırını kolayca düzenleyin); Okuma Düzeni (çok sayıda hücreyi kolayca okuyun ve düzenleyin); Filtrelenmiş Aralığa Yapıştır...
  • Hücreleri / Satırları / Sütunları Birleştirme Veri kaybetmeden; Bölünmüş Hücre İçeriği; Yinelenen Satırları / Sütunları Birleştirme... Yinelenen Hücreleri Önleyin; Aralıkları Karşılaştır...
  • Yinelenen veya Benzersiz'i seçin Satırlar; Boş Satırları Seçin (tüm hücreler boştur); Süper Bul ve Bulanık Bul Birçok Çalışma Kitabında; Rastgele Seçim ...
  • Tam kopya Formül referansını değiştirmeden Birden Çok Hücre; Otomatik Referans Oluştur Birden Çok Sayfaya; Madde İşaretleri Ekle, Onay Kutuları ve daha fazlası ...
  • Metni Çıkar, Metin Ekle, Konuma Göre Kaldır, Alanı Kaldır; Sayfalama Alt Toplamları Oluşturma ve Yazdırma; Hücre İçeriği ve Yorumları Arasında Dönüştür...
  • Süper Filtre (filtre şemalarını kaydedin ve diğer sayfalara uygulayın); Gelişmiş Sıralama ay / hafta / gün, sıklık ve daha fazlasına göre; Özel Filtre kalın, italik ...
  • Çalışma Kitaplarını ve Çalışma Sayfalarını Birleştirin; Tabloları anahtar sütunlara göre birleştirin; Verileri Birden Çok Sayfaya Bölme; Toplu dönüştürme xls, xlsx ve PDF...
  • 300'den fazla güçlü özellik. Office / Excel 2007-2021 ve 365'i destekler. Tüm dilleri destekler. Kuruluşunuzda veya kuruluşunuzda kolay devreye alma. Tam özellikler 30 günlük ücretsiz deneme. 60 günlük para iade garantisi.
kte sekmesi 201905

Office Tab, Office'e Sekmeli Arayüz Getirir ve İşinizi Çok Daha Kolay Hale Getirir

  • Word, Excel, PowerPoint'te sekmeli düzenlemeyi ve okumayı etkinleştirin, Publisher, Access, Visio ve Project.
  • Yeni pencereler yerine aynı pencerenin yeni sekmelerinde birden çok belge açın ve oluşturun.
  • Üretkenliğinizi% 50 artırır ve her gün sizin için yüzlerce fare tıklamasını azaltır!
ofis tabanı
Yorumları sıralama ölçütü
Yorumlar (43)
Henüz derecelendirme yok. İlk değerlendiren siz olun!
Bu yorum sitedeki moderatör tarafından en aza indirildi
Belirli içeriği hücrenin altına yapıştırmak istiyorum. Bu nasıl yapılır? Boş satır yerine birkaç sütuna değer eklemek istiyorum.
Bu yorum sitedeki moderatör tarafından en aza indirildi
Merhaba, değerine göre birden çok satır eklemek istiyorum Örn: 1 değerli hücrenin altına 2 boş satır, 2 değerli hücrenin 3 satır altına, 3 değerli hücrenin 4 satır altına vb. eklemek istiyorum lütfen bana bu konuda yardım edin?
Bu yorum sitedeki moderatör tarafından en aza indirildi
Buna hiç cevap aldın mı? Ben de aynı şeyi yapmaya çalışıyorum.

Aldıkları # haftalık tatile sahip çalışanların bir listesini alın. Her hafta için bir satır eklemek istiyorum. Ne kadar zaman kazandıklarına bağlı olarak 1, 2 veya 3 sıra olacaktır. #s 1 2 3 zaten e-tablomda.
Bu yorum sitedeki moderatör tarafından en aza indirildi
Bir elektronik tabloda bir hücre değeri kullanarak ve başka bir elektronik tabloya satırlar ekleyerek bir sayıya dayalı satırlar eklemek istiyorum.
Bu yorum sitedeki moderatör tarafından en aza indirildi
Mesajınız sayesinde. Ancak sorunuzu daha fazla ayrıntıyla açıklayabilir misiniz? Hangi satırları eklemek istiyorsunuz? Boşluk? Ve sayfada nereye eklemek istiyorsunuz? Yapabilirsen, bana biraz ekran görüntüsü ver. Teşekkür ederim.
Bu yorum sitedeki moderatör tarafından en aza indirildi
Seni seviyorum. Teşekkür ederim.
Bu yorum sitedeki moderatör tarafından en aza indirildi
Bu harikaydı!!. Teşekkürler dostum.
Bu yorum sitedeki moderatör tarafından en aza indirildi
Birden fazla satırı nasıl ekleyebilirim?
Bu yorum sitedeki moderatör tarafından en aza indirildi
Bu VBA'yı deneyebilirsiniz

Alt BoşLine()
'20150203 güncellemesi
Menzil Olarak Dim Rng
Aralık Olarak Dim WorkRng
xInsertNum Uzunluğunu Azalt
' Hatada Devam Sonraki
xTitleId = "Kutools for Excel"
WorkRng = Application.Selection olarak ayarlayın
WorkRng = Application.InputBox("Range", xTitleId, WorkRng.Address, Type:=8) olarak ayarlayın
WorkRng Hiçbir Şey Değilse Sub'dan Çıkın
xInsertNum = Application.InputBox("Eklemek istediğiniz boş satır sayısı ", xTitleId, Type:=1)
xInsertNum = False ise
MsgBox " Eklemek istediğiniz boş satır sayısı ", vbInformation, xTitleId
Exit Sub
Eğer son
WorkRng = WorkRng.Columns(1) olarak ayarlayın
xLastRow = WorkRng.Rows.Count
Application.ScreenUpdating = Yanlış
xRowIndex için = xLastRow'dan 1 Adım -1'e
Set Rng = WorkRng.Range("A" & xRowIndex)
Rng.Value = "0" ise
Rng.Resize(xInsertNum).EntireRow.Insert Shift:=xlDown
Eğer son
Sonraki
Application.ScreenUpdating = True
End Sub
Bu yorum sitedeki moderatör tarafından en aza indirildi
aşağıya boş satırlar eklemek istiyorsanız, bunu deneyin

Alt BoşLine()
'20150203 güncellemesi
Menzil Olarak Dim Rng
Aralık Olarak Dim WorkRng
xInsertNum Uzunluğunu Azalt
' Hatada Devam Sonraki
xTitleId = "Kutools for Excel"
WorkRng = Application.Selection olarak ayarlayın
WorkRng = Application.InputBox("Range", xTitleId, WorkRng.Address, Type:=8) olarak ayarlayın
WorkRng Hiçbir Şey Değilse Sub'dan Çıkın
xInsertNum = Application.InputBox("Eklemek istediğiniz boş satır sayısı", xTitleId, Type:=1)
xInsertNum = False ise
MsgBox " Eklemek istediğiniz boş satır sayısı ", vbInformation, xTitleId
Exit Sub
Eğer son
WorkRng = WorkRng.Columns(1) olarak ayarlayın
xLastRow = WorkRng.Rows.Count
Application.ScreenUpdating = Yanlış
xRowIndex için = xLastRow'dan 1 Adım -1'e
Set Rng = WorkRng.Range("A" & xRowIndex)
Rng.Value = "0" ise
Rng.Offset(1, 0).Resize(xInsertNum).EntireRow.Insert Shift:=xlDown
Eğer son
Sonraki
Application.ScreenUpdating = True
End Sub

Aşağıdaki, yukarıdaki satırları eklemektir.
Bu yorum sitedeki moderatör tarafından en aza indirildi
Merhaba Sunny, bu makro benim için mükemmel çalışıyor; sadece satır sayısını 30'a ve 0'ı metne değiştirmem gerekiyordu: "Kapanış Bakiyesi". Ama şimdi, bu makro tarafından eklenen 30 boş satıra 30 satır yüksekliğindeki bir hücre seçimini kopyalamak istiyorum. Her 30 boş satıra bir aralık kopyalayıp yapıştırmak için yeni bir makro (veya buna bir değişiklik) önerebilir misiniz? 'Şablon' kopyalayıp yapıştırılacak aralığı adlandırdım.
Bu yorum sitedeki moderatör tarafından en aza indirildi
Bu konu hakkında çok büyük yardıma ihtiyacım var. 2 sütunum var, 1'inde veri zamanım 01/01/2016 05:00:00, gün/ay/yıl saat/dakika/saniye ve 2 2. sütunda zamana ilişkin ilgili veriler var.

Benim sorunum, gün boşluklarım olduğu için satırlar arasına veri zamanı eklemek istiyorum. 1. satır 01/01/2016 ve 2. satırda örneğin 10/01/2016 var, yani 9 günüm var. ve bu kod benim için çalışmıyor.

Geri bildirim almak için sabırsızlanıyoruz, lütfen! teşekkürler
Bu yorum sitedeki moderatör tarafından en aza indirildi
Bu VBA'yı deneyebilirsiniz

Alt InsertValueBetween()
'20130825 güncellemesi
Aralık Olarak Dim WorkRng
Menzil Olarak Dim Rng
Varyant Olarak Dim outArr
Dim dic Varyant Olarak
Set dic = CreateObject("Scripting.Dictionary")
'Hatada Devam Devam Et
xTitleId = "KutoolsforExcel"
WorkRng = Application.Selection olarak ayarlayın
WorkRng = Application.InputBox("Range", xTitleId, WorkRng.Address, Type:=8) olarak ayarlayın
num1 = WorkRng.Range("A1").Value
num2 = WorkRng.Range("A" & WorkRng.Rows.Count).Value
aralık = sayı2 - sayı1
ReDim outArr(1 ila aralık + 1, 1 ila 2)
WorkRng'deki Her Rng İçin
dic(Rng.Value) = Rng.Offset(0, 1).Değer
Sonraki
i = 0 için aralığa
outArr(i + 1, 1) = ben + sayı1
Eğer dic.Exists(i + num1) O zaman
outArr(i + 1, 2) = dic(i + num1)
başka
outArr(i + 1, 2) = ""
Eğer son
Sonraki
WorkRng.Range("A1") ile.Resize(UBound(outArr, 1), UBound(outArr, 2))
.Value = çıkışArr
.Seçin
İle bitmek
End Sub


Veya Kutools for Excel'iniz varsa, bu işlevi deneyebilirsiniz:
Bu yorum sitedeki moderatör tarafından en aza indirildi
Çok teşekkürler, ikisini de denedim, 1 satırlık veriye sahip olduğum için ilki, bunu 500 satırın tamamı için yapıyorum ve hiçbir şey yapmıyor, belki de kullanılacak satırlarda bir sınırlaması olduğunu düşünüyorum ve örneğin sadece ilk 500 satırı seçtiğimde eksik satırları oluşturmuyor, eksik verilerin satırlarını değiştiriyor.

Sahip olduğum bir diğer sorun da zaman verilerimin Gün/Ay/Yıl SS: DD: SS'ye sahip olmasıdır.
Bu yorum sitedeki moderatör tarafından en aza indirildi
2'den 3'e kadar, istediğim eksik verileri oluşturuyor tamam, ancak 03/01/2016'nın değeri ortadan kaldırılıyor ve benim de istemediğim bir şeyi ortadan kaldıran bazı zaman verileri var
Bu yorum sitedeki moderatör tarafından en aza indirildi
VBA kodu size yardımcı olmadı üzgünüm, tarih ve saat formatı için çalışabilecek yöntemi bulamıyorum. Sonunda çözümü bulursan bana da haber verir misin? Teşekkür ederim.
Bu yorum sitedeki moderatör tarafından en aza indirildi
Tekrar merhaba Sunny, bunun kodunu düzenleme konusunda biraz başarılı oldum (num1 satırını A2 ve With WorkRng.Range("A2:A100000") olarak değiştirdim.Resize(UBound(outArr, 1)), UBound(outArr, 2) ):


Alt InsertValueBetween()
'20130825 güncellemesi
Aralık Olarak Dim WorkRng
Menzil Olarak Dim Rng
Varyant Olarak Dim outArr
Dim dic Varyant Olarak
Set dic = CreateObject("Scripting.Dictionary")
'Hatada Devam Devam Et
xTitleId = "KutoolsforExcel"
WorkRng = Application.Selection olarak ayarlayın
WorkRng = Application.InputBox("Range", xTitleId, WorkRng.Address, Type:=8) olarak ayarlayın
num1 = WorkRng.Range("A2").Value
num2 = WorkRng.Range("A" & WorkRng.Rows.Count).Value
aralık = sayı2 - sayı1
ReDim outArr(1 ila aralık + 1, 1 ila 2)
WorkRng'deki Her Rng İçin
dic(Rng.Value) = Rng.Offset(0, 1).Değer
Sonraki
i = 0 için aralığa
outArr(i + 1, 1) = ben + sayı1
Eğer dic.Exists(i + num1) O zaman
outArr(i + 1, 2) = dic(i + num1)
başka
outArr(i + 1, 2) = ""
Eğer son
Sonraki
WorkRng.Range("A2:A100000") ile.Resize(UBound(outArr, 1), UBound(outArr, 2))
.Value = çıkışArr
.Seçin
İle bitmek
End Sub



Size grafikleri gösteriyorum, %100 çalışmıyor çünkü A1'den A2'ye kadar olan süreyi oluşturmuyor.
Bu yorum sitedeki moderatör tarafından en aza indirildi
İşte sorum ve sanırım çok zor bir soru.. Filtrelenmiş bir sütunun altına yeni bir satır ekleyen ve sadece ilk üç hücreyi eklenen yeni satıra kopyalayan ve kullanıcı vurmayı bırakana kadar bunu yapmaya devam eden bir vba kodu var mı? "gir" ve filtrelenmiş hücreleri filtreden çıkarmak?
Bu yorum sitedeki moderatör tarafından en aza indirildi
Sorunuz biraz zor ve karmaşık, soruyu forumumuza koyabilirsiniz, belki biri size cevap verebilir. https://www.extendoffice.com/forum.html
Bu yorum sitedeki moderatör tarafından en aza indirildi
merhaba sadece nasıl satır ekleyeceğimi sormak istiyorum, eğer kod, bir hücrenin zaten bir verisi olduğunda satır eklemenin yapılması gerektiğiyse (çok sayıda sayfa içeren bir excel çalışma kitabı içindir :) Teşekkürler!
Bu yorum sitedeki moderatör tarafından en aza indirildi
belki bu vba kodu size yardımcı olabilir. Yukarıdaki satır boş değilse satır ekleyecektir.

Alt yardım()
Dim Sayısı Uzun
Sayım için = ActiveSheet.UsedRange.Rows.count için 1 Adım -1
If Information.IsEmpty(Cells(count, 1)) = False Then Rows(sayım + 1).Insert
Sonraki sayı
End Sub
Bu yorum sitedeki moderatör tarafından en aza indirildi
Merhaba, bir hücredeki ilk 4 basamak değiştiğinde bir satır girmek için bu kodu kullanmaya çalışıyorum (eğer mümkünse)

örneğin,
2222A
2222B
2223K


2222. sayı 3 değil 3 olduğundan satır 2B'den sonra eklenecektir.

Teşekkürler çocuklar!
Bu yorum sitedeki moderatör tarafından en aza indirildi
Merhaba, Bunun için teşekkürler, ancak sıfır olmayan değerin altına bir cingle hücresi eklemem gereken başka bir senaryom var. Herhangi bir öneriyi takdir edin.
Bu yorum sitedeki moderatör tarafından en aza indirildi
Merhaba, Gina, hücrenin üzerine boş olmayan boş satır eklemek için kodu buldum, belki birileri ihtiyacınızı karşılayacak şekilde ayarlayabilir.

Alt Insert_Rows()
LR Kadar Uzun, r Kadar Uzun

Application.ScreenUpdating = Yanlış
LR = Aralık("A" & Rows.Count).End(xlUp).Satır
r = LR için 1 Adım -1
Len(Range("A" & r).Value) > 0 ise
Satırlar(r).Ekle
Eğer son
Sonraki r
Application.ScreenUpdating = True
End Sub

dan geliyorum https://www.mrexcel.com/forum/excel-questions/548675-adding-blank-line-above-row-non-blank-cell.html
Bu yorum sitedeki moderatör tarafından en aza indirildi
Merhaba, bu çok yardımcı oluyor. Ya aşağıya iki satır eklemek istersem ve daha fazla değer istersem. Örneğin 26/04/2019 değerinden sonra iki satır, 03/04/2019 tarihinden sonra iki satır eklemek istiyorum ve liste uzayıp gidiyor. vba'ya eklemeye nasıl devam edebilirim? Üzgünüm hala acemiyim. Şimdiden teşekkürler.
Bu yorum sitedeki moderatör tarafından en aza indirildi
Merhaba Safa, belki Kutools'un boş satır/sütun ekleme yardımcı programını deneyebilirsiniz.
Bu yorum sitedeki moderatör tarafından en aza indirildi
Alt BoşLine()
'20150203 güncellemesi
Menzil Olarak Dim Rng
Aralık Olarak Dim WorkRng
On Error Resume Next
xTitleId = "KutoolsforExcel"
WorkRng = Application.Selection olarak ayarlayın
Set WorkRng = Application.InputBox("Range", xTitleId, WorkRng.Address, Type: = 8)
WorkRng = WorkRng.Columns(1) olarak ayarlayın
xLastRow = WorkRng.Rows.Count
Application.ScreenUpdating = Yanlış
xRowIndex için = xLastRow'dan 1 Adıma - 1
Set Rng = WorkRng.Range("A" & xRowIndex)
Rng.Value = "0" ise
Rng.EntireRow.Shift Ekle: = xlAşağı
Eğer son
Sonraki
Application.ScreenUpdating = True
End Sub


Hücreye her şey koyduğumda ve ayrıca daha fazla değişkenle çalışması için buna ihtiyacım var. Demek istediğim, hücreye 2 koyarsam, sadece 2 değil 1 satır eklemem gerekir.
Bu yorum sitedeki moderatör tarafından en aza indirildi
Miktar 1'den büyükse satır sayısını -1 ekleyen bir miktar sütununa dayalı olarak satır eklemek için makroya ihtiyacım var. Miktar 5 ise, altına 4 satır ekler ve verileri doldurur ve her satırda 5'ten 1'e çağrılan miktarı değiştirir. Tüm adet 1'i atlayın.
Bu yorum sitedeki moderatör tarafından en aza indirildi
Hücre değerine göre belirli sayıda satır eklemek istediğim kodu söyle. örneğin, hücre 18 rakamını içeriyorsa, istediğim yere otomatik olarak 18 satır eklenmeli ve tablonun/hücrenin geri kalanı aşağı kaydırılmalıdır.
Bu yorum sitedeki moderatör tarafından en aza indirildi
Bunun için çok teşekkürler, gerçekten muazzam bir zaman tasarrufu. Yeni satıra biraz metin eklememe izin veren bir kod eklemek mümkün mü? Örneğin, 'x' hedef değerine dayalı olarak yeni satırlar ekliyorum, ardından 'x' hedef değerinin altındaki hücreye 'y' metin değeri eklemek istiyorum. Mümkün mü?
Bu yorum sitedeki moderatör tarafından en aza indirildi
Merhaba. Makro benim için çalışıyor, ancak giriş kutusu hiç gelmeden aralığı/parametreleri her zaman J sütununa ayarlamanın bir yolu var mı? Gelen giriş kutusunun adımını atlamasını istiyorum. Ayrıca, bu makrodan hemen önce, önceki makromun son satırının Range("J:J") olduğundan emin oldum. J sütununun tamamının zaten seçili olduğundan emin olmak için seçin.
Şimdiye kadar kullandığım şey bu.

Menzil Olarak Dim Rng
Aralık Olarak Dim WorkRng
On Error Resume Next
xTitleId = "Devam etmek için Tamam'ı tıklayın"
WorkRng = Application.Selection olarak ayarlayın
WorkRng = Application.InputBox("Range", xTitleId, WorkRng.Address, Type:=8) olarak ayarlayın
WorkRng = WorkRng.Columns(1) olarak ayarlayın
Tuşları Gönder "~"
xLastRow = WorkRng.Rows.Count
Application.ScreenUpdating = Yanlış
xRowIndex için = xLastRow'dan 1 Adım -1'e
Set Rng = WorkRng.Range("A" & xRowIndex)
Rng.Value = "Yeni GMS Hattı" ise
Rng.EntireRow.Shift Ekle:=xlAşağı
Eğer son
Sonraki


Giriş kutusu geldiğinde otomatik olarak enter tuşuna basmasını sağlamak için bazı adımlar arasında SendKeys "~" komutunu kullanmayı denedim ama bu da işe yaramadı. Makroda SendKeys komutunu tam olarak nerede kullanacağımdan veya bir giriş kutusuyla çalışıp çalışmayacağından emin değildim!
Bu yorum sitedeki moderatör tarafından en aza indirildi
lütfen bir veriye sahip olmama yardım et. bir aylık veriye sahibim, bunun için kaçış zamanına göre boş bir satır eklemem gerekiyor
Bu yorum sitedeki moderatör tarafından en aza indirildi
Merhaba, hr.babu08, üzgünüm cevap gecikti. Sanırım boş satırlar eklemek veya eksik dizi verileri için bir işaret yapmak istiyorsunuz, öyleyse, Kutools for Excel'in Eksik Sıra Numarasını Bul özelliğini deneyebilirsiniz.İşte bu özellik hakkında öğretici: https://www.extendoffice.com/product/kutools-for-excel/excel-find-missing-numbers-in-sequence.htmlIf Eksik sıra için boş satırlar eklemek için başka yöntemler istiyorsanız, lütfen şu adresi ziyaret edin:https://www.extendoffice.com/documents/excel/3522-excel-find-missing-dates.html</div>;
Bu yorum sitedeki moderatör tarafından en aza indirildi
Merhaba,
Bu marco renkli hücreler için kullanılabilir/değiştirilebilir mi?
Renkli olan her serinin sonuna en az 10 satır eklemem gerekiyor.
Teşekkürler!
Bu yorum sitedeki moderatör tarafından en aza indirildi
Belirli hücre içerikleri için değerleri olan belirli satırlar eklemem gerekiyor, ancak bunu 3800'den fazla satır için manuel olarak yapmak zorunda kalmadan nasıl yapacağımdan emin değilim

Ör: A1 = Düğüm1
Tarayıcı değerini girmek için bir satır eklemem gerekiyor
Başka bir satır girin ve Yazıcı değerini girin
değer CD'sine sahip başka bir satır.
V.b
Bu yorum sitedeki moderatör tarafından en aza indirildi
Merhaba Chris, işte bir VBA, değer Düğüm1'e eşit olduğunda otomatik olarak üç satır (Tarayıcı, Yazıcı, CD) eklemenize yardımcı olabilir.
Sub BlankLine()
'ByExtendoffice
Dim Rng As Range

Dim WorkRng As Range

Dim xRngI As Range

On Error Resume Next

xTitleId = "KutoolsforExcel"

Set WorkRng = Application.Selection

Set WorkRng = Application.InputBox("Select a range", xTitleId, WorkRng.Address, Type:=8)

Set WorkRng = WorkRng.Columns(1)

xLastRow = WorkRng.Rows.Count

Application.ScreenUpdating = False

For xRowIndex = xLastRow To 1 Step -1

  Set Rng = WorkRng.Range("A" & xRowIndex)

  If Rng.Value = "Node1" Then

    Rng.Offset(1, 0).EntireRow.Insert Shift:=xlDown

    Rng.Offset(1, 0).EntireRow.Insert Shift:=xlDown

    Rng.Offset(1, 0).EntireRow.Insert Shift:=xlDown

    Rng.Offset(1, 0).Value = "Scanner"

    Rng.Offset(2, 0).Value = "Printer"

    Rng.Offset(3, 0).Value = "CD"

  End If

Next

Application.ScreenUpdating = True

End Sub

İşinize yararsa lütfen bana bildirin.
Buraya henüz hiç yorum yapılmamış
Daha Çok
Lütfen yorum yazın
Misafir olarak yayınlama
×
Bu gönderiyi değerlendirin:
0   Karakterler
Önerilen Konumlar

Bizi takip et

Telif Hakkı © 2009 - www.extendoffice.com. | Tüm hakları Saklıdır. Tarafından desteklenmektedir ExtendOffice. | | | Site Haritası
Microsoft ve Office logosu, Microsoft Corporation'ın Amerika Birleşik Devletleri ve / veya diğer ülkelerdeki ticari markaları veya tescilli ticari markalarıdır.
Sectigo SSL ile korunmaktadır