NYARCH пише
Искам Excel да копира цял ред в нов работен лист на Excel въз основа на запис в клетка. Например имам данни в клетки A8: AG8, искам Excel да копира целия ред на лист "a", ако стойността в H8 е "ir", и лист "b", ако стойността в H8 е "RR". Най-сложната част, а не просто копирана, трябва ми да бъде копирана в следващия празен ред на работния лист. От около 150 реда само около 15 от всеки тип ще бъдат действително копирани в нов лист.
MrExcel ще присъди 50 бонус точки на всеки читател, който си спомня статията от сп. Lotus, предлагаща 10 страхотни съвета, където съвет № 4 беше „Използвайте клавиша End, за да се придвижите до края на диапазона“. Връщайки се към дните на Lotus, можете да поставите клетъчния указател навсякъде в блок данни, да натиснете END и след това надолу, а указателят на клетката ще се придвижва до края на диапазона. Excel има подобна функционалност, VBA има подобна функционалност и това е ключът към намирането на последния ред данни на лист.
Техниката на VBA е да се използва End (xlDown), за да се симулира клавишът End + Down или End (xlUp), за да се симулира клавишът End + Up. Натискането на тази последователност от клавиши ще премести показалеца на клетката към следващия ръб на непрекъснат диапазон от данни. Представете си, че има стойности в A1: A10 и A20: A30. Започнете в А1. Натиснете End + Down и показалецът на клетката се премества в A10. Натиснете End + Down и отивате до A20, който е горният ръб на следващия непрекъснат диапазон от данни. Натиснете End + Down и ще преминете към A30. Всъщност се затруднявам как да обясня това поведение на прост английски. Просто опитайте и ще видите как работи.
Трикът, който използвам, е да започна от колона А в последния ред в електронната таблица и след това да натисна End + Up. Това ще ме отведе до последния ред с данни. След това знам да използвам следващия ред надолу като празен ред.
Ето груб макрос за решаване на проблема от тази седмица. Да, със сигурност бихте могли да направите това по-елегантно с AutoFilter. Понастоящем данните са на Sheet1, със заглавия в ред 2.
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 SubКато се има предвид, че Excel 2007 има повече от 65 536 реда, можете да използвате този макрос, така че да е съвместим напред. Имайте предвид, че тук използвам КЛЕТКИ (ред, колона) вместо RANGE:
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 SubЗа съвети как да използвате макрос, вижте Представяне на редактора на Excel VBA.
