0

UDF "NAV()" は、最初の引数 (常に日付) に基づいてネットワーク ドライブ上の正しいレポートを検索し、すべてのワークシートをループして、2 番目の引数と同じ行と同じ列を持つデータを見つけるように設計されています。 3 番目の引数 (2 番目と 3 番目はテキストまたは数値)。

即時ウィンドウで確実に動作します。常に #VALUE を返します! =NAV(D7,D8,D9) または =NAV(2/19/2016,"Net Asset Value","221-I") などのワークシートで使用する場合。

一般に、UDF 内の他のセルを変更しようとすると、この動作が発生する可能性があるように見えますが、私の関数はそれを行いません。また、すべての範囲参照がどのワークブックとワークシートを指定していると思うので、それも問題ではないと思います。次にどこを見るべきかわかりません。

また、関数は、ユーザーが探しているものが見つからない場合、Outlook を介してレポートを電子メールで送信しようとします。それが関連しているかどうかはわかりません。

繰り返しになりますが、当惑しているのは、このコードがイミディエイト ウィンドウで正常に動作しているように見えますが、#VALUE! しか返されないことです。ワークシートで使用する場合。

NAV() がイミディエイト ウィンドウで正しく機能する原因を判断するために、以下のコードを他にどこで調べることができますか? ワークシートで使用する場合

Option Explicit

Function NAV(ByVal NAVDate As Date, ByVal matchRow As Variant, ByVal matchColumn As Variant) As Variant
'Application.ScreenUpdating = False
Application.Volatile True

    NAV = FindItemOnWorksheet(NAVDate, matchRow, matchColumn)

'Application.ScreenUpdating = True
End Function


Function FindItemOnWorksheet(ByVal NAVDate As Date, ByVal ItemSpecies As Variant, ByVal ItemGenus As Variant) As Variant
' Finds Item by opening NAV workbook with correct date, activating correct worksheet, and searching for correct row and column
Dim startingRange As Range
Dim ws As Worksheet
Dim wb As Workbook
Dim theDate As Date
Dim theItemSpecies As String
Dim theItemGenus As String

theDate = NAVDate
theItemSpecies = ItemSpecies
theItemGenus = ItemGenus

Set wb = GetWB(NAVDate)

'Loop through ws
Dim WS_Count As Integer
Dim i As Integer

WS_Count = wb.Worksheets.Count

For i = 1 To WS_Count


    Set ws = wb.Worksheets(i)
    Set startingRange = ws.Range("A1:Z100")

    Dim theRow As Range
    Dim theColumn As Range

    Set theRow = startingRange.Cells.Find(theItemSpecies, SearchDirection:=xlPrevious, lookat:=xlWhole)
    If Not (theRow Is Nothing) Then
        Set theColumn = startingRange.Cells.Find(theItemGenus, SearchDirection:=xlPrevious, lookat:=xlWhole)
        If Not (theColumn Is Nothing) Then
            FindItemOnWorksheet = ws.Cells(theRow.Row, theColumn.Column).Value

            wb.Close
            Exit Function
        End If
   End If

Next i
'Loop if no hit on either row or column Find()

'following executes only if no match found
MsgBox "No Match Found. Make sure you are entering arguments--" & vbNewLine & _
        "       The Date of NAV, " & vbNewLine & _
        "       the entry found in the right row of NAV workbooks (e.g. 'Net Asset Value'), " & vbNewLine & _
        "       the right column (e.g. 'Fund')." & vbNewLine & _
        " This function will only find exact matches." & vbNewLine & vbNewLine & _
        "Now emailing developer to ask for a fix."

Dim OutApp As Object
Dim OutMail As Object
Dim strbody As String

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

strbody = "User attempted" & _
                "=FindItemOnWorksheet( " & theDate & ", " & theItemSpecies & ", " & theItemGenus & " )" & vbNewLine & _
                "theDate type " & TypeName(theDate) & vbNewLine & _
                "theItemSpecies type " & TypeName(theItemSpecies) & vbNewLine & _
                "theItemGenus type " & TypeName(theItemGenus)

On Error Resume Next
With OutMail
    .To = <Address Removed>
    .CC = ""
    .BCC = ""
    .Subject = "FindItemOnWorksheet Error"
    .Body = strbody
    '.Attachments.Add ("C:\file.xlsx")
    .Send
End With
On Error GoTo 0

Set OutMail = Nothing
Set OutApp = Nothing

FindItemOnWorksheet = "Error"
'wb.Close
Exit Function
End Function


Function GetWB(ByVal NAVDate As Date) As Workbook
'Open requested workbook, return to parent procedure

Dim wbPath As String
Dim wbYear As String
Dim wbMonth As String

Dim wbWeek As String

Dim wbFile As String
Dim wbString As String
Dim wb As Workbook
Dim BackADay As Boolean

Dim OriginalNAVDateRequested As Date
OriginalNAVDateRequested = NAVDate

BackADay = True

'Loop through possible file tree structures and dates to find the closest NAV in the past to the date requested.
Do While BackADay = True

    'Don't go back to a previous week if cannot find current NAV
    If OriginalNAVDateRequested - NAVDate > 4 Then
        BackADay = False
    End If

    wbPath = <Network Path Removed>
    wbYear = CStr(Year(NAVDate)) & "\"
    wbMonth = MonthName(Month(NAVDate)) & " " & wbYear

    wbWeek = DateFormat(NAVDate) & "\"

    wbFile = Dir(wbPath & wbYear & wbMonth & wbWeek & "*Valuation Package*.xlsx")

    'Pricings with distributions have differing tree structure
    If wbFile = "" Then
        wbWeek = wbWeek & "POST Distribution " & wbWeek
        wbFile = Dir(wbPath & wbYear & wbMonth & wbWeek & "*Valuation Package*.xlsx")
        If wbFile = "" Then
            NAVDate = NAVDate - 1
        Else: BackADay = False
        End If
    Else: BackADay = False
    End If

Loop

wbString = wbPath & wbYear & wbMonth & wbWeek & wbFile

Set wb = Workbooks.Open(wbString, UpdateLinks:=False, ReadOnly:=True)
Set GetWB = wb

End Function

Function DateFormat(ByVal X As Date) As String
'Appends leading zeroes if needed to achieve form "00" for any two digit integer, and converts to string
Dim MM As String
Dim DD As String
Dim YYYY As String

If Month(X) < 10 Then
    MM = "0" & CStr(Month(X))
Else
    MM = CStr(Month(X))
End If

If Day(X) < 10 Then
    DD = "0" & CStr(Day(X))
Else
    DD = CStr(Day(X))
End If

YYYY = CStr(Year(X))

DateFormat = MM & "." & DD & "." & YYYY

End Function
4

1 に答える 1

0

Worksheet_Changeイベント内でワークブックを開くことができます。

デモンストレーションとして、 を変更するとSheet1!A2、Excel はそのセル値でワークブック名​​を開こうとし、ステータスを に出力しますSheet1!A4。

以下をモジュールに入れます：

Option Explicit

Function TryOpenWB(ByVal oItem As Variant) As Variant
    Dim sOut As String
    Dim oWB As Workbook
    On Error Resume Next
    Set oWB = Workbooks.Open(CStr(oItem))
    If oWB Is Nothing Then
        sOut = "Cannot open """ & CStr(oItem) & """"
    Else
        sOut = "Opened """ & CStr(oItem) & """ successfully."
        'oWB.Close
    End If
    TryOpenWB = sOut
End Function

次に、以下のワークシート モジュール (私はデモ用に Sheet1 を使用しました):

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address = Range("A2").Address Then
        Application.EnableEvents = False
        Range("A4").Value = TryOpenWB(Target)
        Application.EnableEvents = True
    End If
End Sub

したがって、このアイデアは、一部のセル アドレスが一致する場合にのみワークブックを開くことです。

于 2016-02-26T01:18:14.143 に答える