Как да търсим и отпечатаме запис чрез VBA for Microsoft Excel?

Posted by
/ / 2 коментара

Наскоро ме попитаха как ще изглежда макрос, който да търси определена стойност в дадена колона и след като я намери да отпечатва целия ред. В този пост ще опиша как с помощта на няколко реда код на Visual Basic for Microsoft Excel , се извършва търсене чрез обхождане на масив с броячен цикъл (For_Next) и условен оператор (If_Then).

Примерът, който ще разгледам, може да се използва за изписване на дадена стока от склад.

Имаме таблица с резервни части за автомобили (Фигура 1).

Фигура 1

Може да се наложи да потърсим резервната част по нейния номер, който се намира в колона В.

За целта ще изполвам ред, в който потребителят да въвежда номера на стоката:

       a = InputBox(„Въведете номер на стоката“)

С този ред се отваря прозорец (Фигура 2)

Фигура 2

След въвеждане на номера трябва да извършим самото търсене. Това може да се направи с обикновен цикъл, който обхожда всички записи в колона В и проверява дали въведения от нас номер отговаря на записа в клетката:

For i = 1 To Range(„A2“).CurrentRegion.Rows.Count

If ActiveCell.Value = a Then  ‘Проверяваме дали стойността в текущата клетка е същата като въведената от потребителя

Rows(ActiveCell.Row).Select  ‘Избира целия ред от клетката, която отговаря на намерената стойност

Selection.PrintOut  ‘Отпечатва избрания ред

Else

ActiveCell.Offset(1, 0).Select  ‘Избира клетката на следващия ред спрямо активната

End If

Next i

Тук интересната част е определянето на последен ред на цялата таблица, за да сме сигурни, че цикълът ще обходи всички записи. Това се случва със следния ред:

 Range(„A2“).CurrentRegion.Rows.Count

В дадения пример, данните започват от клетка А2. Ето защо и в кода използвам начална точка А2. Свойството CurrentRegion означава всички клетки от базата, които не са прекъснати с празен ред или колона. В резултат от горния ред ще даде броя редове, в които има някаква информация записана.

Ето как изглежда цялата процедура:

Sub find_record()

Dim a As String

Dim i As Integer

a = InputBox(„Въведете номер на стоката“)

Range(„B3“).Select

For i = 1 To Range(„A2“).CurrentRegion.Rows.Count

If ActiveCell.Value = a Then

Rows(ActiveCell.Row).Select

Selection.PrintOut

Else

ActiveCell.Offset(1, 0).Select

End If

Next i

End Sub

Така описаният пример може да се използва за всички версии на Microsoft Excel след 2003 включително.

За конкретни въпроси и повече информация, относно курсовете и обученията на ITraining по темата VBA for Microsoft Excel и по всички офис продукти на Microsoft, не се колебайте да се свържете с мен.

Още публикации по темата:

  • Здравейте,
    Захванал съм се с една сложна за мен задача, но за вас доста елементарна надявам се.
    Обръщам се към вас, тъй като след доста ровене и писане във форуми и сайтове, никой не успя да ми помогне.

    Въпросът ми е следният:
    Искам да сортирам и копирам данни по предварително зададен признак (текст) от един Sheet (Sheet2) в друг (Sheet3), с помощта на бутон, който се намира в Sheet1. Стойността, по която ще се извършва сортирането е зададена с ComboBox.
    т.е имам набор от данни съхранявани в Sheet2 (населено място, община, област). Искам когато кликна върху бутона за сортиране в Sheet1, всички съвпадения по предварително зададения признак да бъдат копирани заедно със целия ред и записани на точно определено място в Sheet 3 – примерно като начало на записа да се зададе C3.
    Това е кода който използвах, но имам два проблема:
    1. Кода сработва единствено когато бутона е инсталиран на листа с данни (Sheet2)
    2. Данните се записват в Sheet3 единствено от клетка А1 (дава ми грешка когато се опитам да променя адреса на клетката).
    Ето го и кода:

    Private Sub CommandButton1_Click()
    Dim startRa As Range
    Dim endRa As Range
    Dim DataRowNum As Integer, SheetRowNum As Integer

    Range(„A1“).Select
    Cells.Find(What:=ComboBox1.Value, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
    :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
    False, SearchFormat:=False).Activate
    Set startRa = ActiveCell

    Do
    Set endRa = ActiveCell
    Cells.Find(What:=ComboBox1.Value, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
    :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
    False, SearchFormat:=False).Activate
    Loop While ActiveCell.Row = endRa.Row + 1

    Rows(startRa.Row & „:“ & endRa.Row).Select

    Selection.Copy Destination:=Sheet3.Range(„a65536“).End(xlUp).Offset(1, 0)

    End Sub

    Ще ви бъда много благодарен , ако някой успее да ми помогне

  • Боряна Петрова

    Здравейте,
    Аз бих използвала една много проста и ясна техника:

    Private Sub CommandButton1_Click()

    Dim MyValue
    Dim MyData As Range

    ‘В клетка P1 от sheet 1 може да запишем стойността от Combobox-a
    ‘MyValue е променлива, която ще пази тази стойност
    MyValue = Sheet1.Range(„P1“).Value

    ‘Гарантираме, че сме избрали правилния лист
    Worksheets(„Sheet2“).Select
    Range(„A1“).CurrentRegion.Select

    Set MyData = Selection

    ‘Филтрираме данните по зададения критерий

    MyData.AutoFilter Field:=1, Criteria1:=MyValue

    ‘със следващия ред избягваме селектирането на заглавен ред
    ActiveCell.Offset(1, 0).Select
    ‘ Маркираме, копираме и поставяме, където искаме 🙂
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Copy
    Sheets(„Sheet3“).Select
    Range(„C3“).Select
    ActiveSheet.Paste

    ‘Чистим филтъра, за да сме готови за следващ критерий
    MyData.AutoFilter
    End Sub

    Моля да ми пишете, дали това Ви устройва.