Excel - Aramak ve kopyalamak için makro oluşturma

Konu

Satırında karşılık gelen verilerle tüm farklı tarihleri ​​olan bir elektronik tablom var. Aynı tarihe sahip birçok satır var ve aynı tarihleri ​​aramak için bir makro oluşturmak ve bunları sayfa 2'ye kopyalayıp yapıştırmak, böylece onları sıraya koyabilirim

örnek:

 27-Eyl 27-Eyl 27-Eyl 28-Eyl 28-Eyl 01-Eki 01-Eki 

Nasıl makro oluşturulacağı hakkında hiçbir fikrim yok, ancak internet üzerinden kendi verilerimi eklemek için değiştirebileceğim birini bulmak için interneti araştırdım.

 Alt SearchForString () Dim LSearchRow Tamsayı Olarak Dim LCopyToRow Hatalı Tamsayı Olarak GoTo Err_Execute 'Satır 6'da arama başlat LSearchRow = 6' Sayfa 2'de satır 110'a veri kopyalamaya başlayın (satır sayacı değişkeni) LCopyToRow = 110 Süre Len ("A" & CStr (LSearchRow).) Değer)> 0 'A = "27-Sep" sütunundaki değer ise, tüm satırı Sheet2 ise Range ("A" ve CStr (LSearchRow))' e kopyalayın. Value = "27 = Sep" 'Satırları kopyalamak için Sayfa1'deki satırı seçin (CStr (LSearchRow) & ":" & CStr (LSearchRow)). Selection.Copy'yi seçin' Sıradaki satırlarda Sayfa2'ye satır yapıştırın ("Sayfa2"). Satırlar'ı seçin (CStr (LCopyToRow)) & ":" & CStr (LCopyToRow)) ActiveSheet.Paste 'ı seçin. Sayacı bir sonraki satıra taşı LCopyToRow = LCopyToRow + 1' Sayfaları aramaya devam etmek için Sayfa1'e geri dönün ("Sayfa1"). LSearchRow = LSearchRow + 1 Wend 'A109 hücresindeki konumu Application.CutCopyMode = False Range ("A109"). MsgBox'u seçin "Tüm eşleşen veriler kopyalandı." Çıkış Sub Err_Execute: MsgBox "Bir hata oluştu." Son Alt 

Çözüm

İki makro "test" ve "geri al" veriyorum

örnek sayfa böyledir (sayfa 1) - sıralamak için gerekli değil

tarih bilgisi1 veri2

3/1/2010 37 1

3/2/2010 65 96

3/3/2010 48 46

3/2/2010 78 54

3/5/2010 3 38

3/2/2010 83 58

3/3/2010 45 78

"test" makrosunu deneyin ve sayfa2'ye bakın

tekrar test etmek istiyorsan

1. run "geri al"

sonra

2. basamak "testi"

makrolar

 Alt test () Dim r Menzil, r1 Menzil, r2 Menzil Dim c2 Menzil, Menzil Çalışma Sayfaları ("sayfa1") öğesini seçin. Set Etkinleştirin r = Menzil (Menzil ("A1"), Menzil ("A1") .End (xlDown)) Set r1 = Aralık ("a1"). End (xlDown) .Offset (5, 0) r.AdvancedFilter eylemi: = xlFilterCopy, copytorange: = r1, benzersiz: = True Set r2 = Range (r1) .Offset (1, 0), r1.End (xlDown)) Her c2 için r2'de Çalışma Sayfası İşlevinde.FiyatAf (r, c2)> 1 Ardından Aralıklı ("A1"). CurrentRegion .AutoFilter alanı: = 1, Kriter1: = c2.Value .Cells.SpecialCells (xlCellTypeVisible) .Copy Çalışma Sayfaları ("sheet2"). Hücreler (Rows.Count, "A"). End (xlUp) .Offset (1, 0). ActiveSheet Sonunda Bitirilecek. AutoFilterMode = Yanlış Sonraki c2 Çalışma Sayfaları ("sayfa2"). Etkinleştir Do cfind = ActiveSheet.Cells.Find (ne: = "date", bakınız: = xlWhole, sonra: = Aralık ("A2")) Çıkın cfind.EntireRow.Delete Döngü Çalışma Sayfalarını ("sayfa1"). Aralık ("A1") .TümRow.Copy Çalışma Sayfaları ("sayfa2"). Aralık ("A1"). PasteSpecial Application.CutCopyMode = False End Sub Sub undo (Geri Al) ) Çalışma sayfaları ("sayfa2") Hücreler. Son Altını Temizle 

Not

Forumdaki bu ipucu için venkat1926'ya teşekkür ederiz.

Önceki Makale Sonraki Makale

En Ipuçları