Преобразовать подпрограмму в функцию

Question

Как преобразовать подпрограмму в функцию? Мне нужно передать аргумент.

Sub maJolieProcedure()
    With Worksheets("employes").Range("A:A")
        Set c = .Find(what:="Smith")
        If Not c Is Nothing Then
            firstAddress = c.Row
            Worksheets("employes").Rows(firstAddress).Copy _
    Destination:=Worksheets("rapport").Range("A1")
            MsgBox "Ok"
        Else
            MsgBox "Nok"
        End If
    End With
End Sub

работает.

Function executerMaJolieProcedure(Texte As String) As String

    '   e.g. executerMaJolieProcedure('Smith')

    With Worksheets("employes").Range("A:A")
        Set c = .Find(what:=Texte)
        If Not c Is Nothing Then
            firstAddress = c.Row
            Worksheets("employes").Rows(firstAddress).Copy _
    Destination:=Worksheets("rapport").Range("A1")
            MsgBox "Ok"
        Else
            MsgBox "Nok"
        End If
    End With
End Function

не работает.

Дополнительный вопрос ... Как сделать акцент на " лист сотрудников вместо отображения пустой ячейки после выполнения функции? :)

Спасибо за вашу помощь.

Answer 1

Похоже, вам нужны данные из первой строки адреса в первой строке (A1) в рабочих листах ("rapport"). Это можно сделать с помощью функции VLOOKUP. Но так как вы ищете код VBA ...

Следующая функция может быть введена как формула массива, выбирая ячейки в первой строке. .. (Код немного изменен)

Function executerMaJolieProcedure(Texte As String)
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets("employes")
    Dim lastRow As Long, lastCol As Long, dataRng As Range, FirstRng As Range
    lastRow = ws.Cells(1048576, 1).End(xlUp).Row
    lastCol = ws.Cells(2, 16384).End(xlToLeft).Column
    Set dataRng = ws.Range(ws.Range("A2"), ws.Cells(lastRow, lastCol))
    Set FirstRng = dataRng.Find(Texte)
    executerMaJolieProcedure = ws.Range(ws.Cells(FirstRng.Row, 1), ws.Cells(FirstRng.Row, lastCol))

End Function    

См. Ниже скриншот. Формула массива (Crtl + Shift + Enter) вводится в A1: I1. Формула находит первую строку для «TATAMOTORS» и возвращает значения строк из таблицы.

Или Vlookup в VBA

Function VBAVlookup(Texte As String)
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets("employes")
    Dim lastRow As Long, lastCol As Long, dataRng As Range, FirstRng As Range
    lastRow = ws.Cells(1048576, 1).End(xlUp).Row
    lastCol = ws.Cells(2, 16384).End(xlToLeft).Column
    Set dataRng = ws.Range(ws.Range("A2"), ws.Cells(lastRow, lastCol))
    VBAVlookup = WorksheetFunction.VLookup(Texte, dataRng, ActiveCell.Column, False)

End Function

Или просто так, если Range зафиксирован ..

Function VBAVlookup3(Texte As String)
Dim DataRng As Range
Set DataRng = Worksheets("employes").Range("A:Z")
VBAVlookup3 = WorksheetFunction.VLookup(Texte, DataRng, ActiveCell.Column, False)
End Function

Answer 2

Здесь дается простая демонстрация того, как вызвать функцию, тот же метод с sub.

Sub test()

Call test2(3)

End Sub


Function test2(c) ' suggest you to use sub to change the cells.

b = 1 + c
MsgBox b

End Function

, чтобы изменить рабочий лист на сотрудников, вы можете

worksheets("employes").active

Мне очень очень любопытно, кто дает мне «-1» как бесполезный. Это вполне понятно. Просто скопируйте ваш оригинальный код в соответствии с моим решением. Это работает.

Sub test01()

Call executerMaJolieProcedure("Smith")

End Sub
Function executerMaJolieProcedure(Texte As String) As String

    '   e.g. executerMaJolieProcedure('Smith')

    With Worksheets("employes").Range("A:A")
        Set c = .Find(what:=Texte)
        If Not c Is Nothing Then
            firstAddress = c.Row
            Worksheets("employes").Rows(firstAddress).Copy _
    Destination:=Worksheets("rapport").Range("A1")
            MsgBox "Ok"
        Else
            MsgBox "Nok"
        End If
    End With
End Function

Answer 3

Вам не нужна функция, вам нужен Sub с аргументом :

Sub MAIN()
    Dim s As String
    s = "whatever"
    maJolieProcedure s
End Sub


Sub maJolieProcedure(Texte As String)
    With Worksheets("employes").Range("A:A")
        Set c = .Find(what:=Texte)
        If Not c Is Nothing Then
            firstAddress = c.Row
            Worksheets("employes").Rows(firstAddress).Copy _
    Destination:=Worksheets("rapport").Range("A1")
            MsgBox "Ok"
        Else
            MsgBox "Nok"
        End If
    End With
End Sub

(Функции в VBA предназначены только для возврата значений, а не для изменить ячейки листа.)