NYARCH yazıyor
Excel'in bir satırın tamamını bir hücre girişine göre yeni bir Excel çalışma sayfasına kopyalamasını istiyorum. Örneğin, A8: AG8 hücrelerindeki verilerim var, Excel'in H8'deki değer "ir" ise tüm satırı "a" sayfasına ve H8'deki değer "RR" ise "b" sayfasına kopyalamasını istiyorum. En karmaşık kısım ve sadece kopyalanmamış, çalışma sayfasındaki bir sonraki boş satıra kopyalanmasına ihtiyacım var. Yaklaşık 150 satırdan her türden yalnızca yaklaşık 15'i yeni bir sayfaya kopyalanacaktır.
MrExcel, 4 numaralı ipucunun "Bir Aralığın Sonuna Gitmek için Son Tuşunu Kullanın" olduğu 10 harika ipucu sunan Lotus Magazine makalesini hatırlayan herhangi bir okuyucuya 50 bonus puan verecek. Lotus günlerine geri dönersek, hücre işaretleyicisini bir veri bloğunun herhangi bir yerine koyabilir, END tuşuna basıp aşağıya basabilirsiniz ve hücre işaretçisi aralığın sonuna kadar gidecekti. Excel'in de benzer işlevleri vardır, VBA'nın da benzer işlevleri vardır ve bu, bir sayfadaki son veri satırını bulmanın anahtarıdır.
VBA tekniği End + Down tuşunu simüle etmek için End (xlDown) veya End + Up tuşunu simüle etmek için End (xlUp) kullanmaktır. Bu tuş dizisine basmak, hücre işaretçisini bitişik bir veri aralığının sonraki kenarına taşıyacaktır. A1: A10 ve A20: A30'da değerler olduğunu hayal edin. A1 ile başlayın. End + Down tuşlarına basın ve hücre işaretçisi A10'a hareket eder. End + Down tuşlarına basın ve bir sonraki bitişik veri aralığının en üst kenarı olan A20'ye gidin. End + Down'a basın ve A30'a gideceksiniz. Aslında bu davranışı basit bir İngilizce ile nasıl açıklayacağımı bilmiyorum. Sadece deneyin ve nasıl çalıştığını göreceksiniz.
Kullandığım numara, elektronik tablodaki son satırdaki Sütun A'dan başlamak ve ardından End + Up'a basmak. Bu beni verilerle son satıra götürecektir. Sonra bir sonraki satırı boş satır olarak kullanacağımı biliyorum.
İşte bu haftanın problemini çözmek için kaba kuvvet makrosu. Evet, bunu bir Otomatik Filtre ile kesinlikle daha zarif bir şekilde yapabilirsiniz. Veriler şu anda Sayfa1'de ve 2. satırda başlıklarla yer alıyor.
Public Sub CopyRows() Sheets("Sheet1").Select ' Find the last row of data FinalRow = Range("A65536").End(xlUp).Row ' Loop through each row For x = 2 To FinalRow ' Decide if to copy based on column H ThisValue = Range("H" & x).Value If ThisValue = "ir" Then Range("A" & x & ":AG" & x).Copy Sheets("a").Select NextRow = Range("A65536").End(xlUp).Row + 1 Range("A" & NextRow).Select ActiveSheet.Paste Sheets("Sheet1").Select ElseIf ThisValue = "RR" Then Range("A" & x & ":AG" & x).Copy Sheets("b").Select NextRow = Range("A65536").End(xlUp).Row + 1 Range("A" & NextRow).Select ActiveSheet.Paste Sheets("Sheet1").Select End If Next x End SubExcel 2007'nin 65.536'dan fazla satırı olduğu göz önüne alındığında, bu makroyu ileriye dönük olarak uyumlu olması için kullanabilirsiniz. Burada RANGE yerine CELLS (Satır, Sütun) kullandığımı unutmayın:
Public Sub CopyRows() Sheets("Sheet1").Select ' Find the last row of data FinalRow = Cells(Rows.Count, 1).End(xlUp).Row ' Loop through each row For x = 2 To FinalRow ' Decide if to copy based on column H ThisValue = Cells(x, 8).Value If ThisValue = "ir" Then Cells(x, 1).Resize(1, 33).Copy Sheets("a").Select NextRow = Cells(Rows.Count, 1).End(xlUp).Row + 1 Cells(NextRow, 1).Select ActiveSheet.Paste Sheets("Sheet1").Select ElseIf ThisValue = "RR" Then Cells(x, 1).Resize(1, 33).Copy Sheets("b").Select NextRow = Cells(Rows.Count, 1).End(xlUp).Row + 1 Cells(NextRow, 1).Select ActiveSheet.Paste Sheets("Sheet1").Select End If Next x End SubBir makronun nasıl kullanılacağına ilişkin ipuçları için, bkz. Excel VBA Düzenleyicisine Giriş.
