打开excel文件并获取特定单元格中值的函数vba

问题描述 投票：0回答：4

我正在尝试使用 VBA 读取 Excel 文件的文件名，打开它，获取其中的值，然后将该值写入我的主 Excel 文件中的单元格中。

具体来说，在一个名为 GetValues.xlsm 的 Excel 工作表中，我在单元格“A1”中有一个文件名“Test1.xlsx”。 我正在尝试打开此文件，然后将单元格“A1”中的值分配给 GetValues.xlsm 中的单元格“B1”。 我正在尝试使用下面的函数来执行此操作；

Function Getvalue(myFile)
'Dim myPath As String
'Dim myExtension As String
myPath = Application.ActiveWorkbook.Path & "\"
myFile = myPath & myFile
Workbooks.Open myFile
Debug.Print "myFile: "; myFile
Debug.Print "ActiveWorkbook: "; ActiveWorkbook.Name
'Val = ActiveWorkbook.Worksheets(1).Range("A1").Value
GetValue = 1
End Function

因此，我在 GetValues.xlsm 的单元格“B1”中输入

=GetValue(A2)

这给了我结果：

myFile: G:\Teaching-CAL\MAE343-CompressibleFlow\04_Codes\LVL\Test1.xlsx
ActiveWorkbook: GetValues.xlsm

我的问题是，我期望 ActiveWorkbook 是 Test1.xlsx 文件，但正如您在输出中看到的，它给了我 GetValues.xlsm。

我将值 1 分配给“GetValue”，以便我可以尝试调试此函数。

预先感谢您的帮助。

excel vba
4个回答
2
投票

如果您可以使用“Test1.xlsx”中单元格 A1 的值填充“GetValues.xlsm”活动工作表的单元格 B1，无需 UDF 且无需打开“Test1.xlsx”工作簿：

Sub test()
Dim p As String: Dim f As String
Dim s As String: Dim c As String
    p = ThisWorkbook.Path & "\" 'the path directory
    f = Range("A1").Value 'the name of the file
    s = "Sheet1" 'the name of the sheet
    c = "a1" 'the cell
    Ret = "'" & p & "[" & f & "]" & _
          s & "'!" & Range(c).Address(True, True, -4150)
    Range("B1").Value = ExecuteExcel4Macro(Ret)
End Sub

上面的子程序将使用您在“GetValues.xlsm”活动工作表的单元格 A1 中编写的无论什么_the_name_of_the_ExcelFile 的单元格 A1sheet1 的值填充“GetValues.xlsm”活动工作表的单元格 B1，而不打开该无论什么_the_name_of_the_ExcelFile。

“GetValues.xlsm”必须与whatever_the_name_of_the_ExcelFile位于同一文件夹中。

2
投票

您需要从子函数中调用函数，而不是从工作表单元格中作为 UDF 调用：

Sub ProcessPaths()
    Dim c As Range
    'loop over cells with file paths
    For Each c In ActiveSheet.Range("A1:A10") 'for example
        c.Offset(0, 1).Value = GetValue(c.Value) 'populate ColB
    Next c
End Sub

Function GetValue(myFile)
    If Len(Dir(myFile)) > 0 Then
        With Workbooks.Open(myFile, ReadOnly:=True)
            'GetValue = .Worksheets(1).Range("A1").Value  'read from cell
            GetValue = .Worksheets(1).Evaluate( _
                         "=SUMIF(B1:B50,""Current"",A1:A50)") 'execute a function
            .Close False
        End With
    Else
        GetValue = "File?"
    End If
End Function
0
投票

不要使用 ActiveWorkbook，而是将打开的工作簿分配给变量

Function Getvalue(myFile)
    'Dim myPath As String
    'Dim myExtension As String
    Dim valueWorkbook As Workbook
    'The less you use ActiveWorkbook the better
    'use ThisWorkbook to refer to the workbook that contains the Code
    myPath = Application.ThisWorkbook.Path & "\"
    myFile = myPath & myFile
    Set valueWorkbook = Workbooks.Open(myFile)
    Debug.Print "myFile: " & myFile
    Debug.Print "ActiveWorkbook/ValueWorkbook: " & valueWorkbook.Name
    cellValue = valueWorkbook.Worksheets(1).Range("A1").Value
    MsgBox "Value in Range A1 is: " & cellValue & " of file: " & valueWorkbook.Name
    GetValue = 1
End Function
0
投票

伙计们，我编写了一个用于合并文件的代码，但我想重新修改它，但没有正确的想法，有人可以帮助我吗？

Sub Master_File()
Dim n As Integer
Dim wb As Integer
Dim master As String
Dim userfile As String
'Dim l_Row As Long
'Dim l_Dist As Long

Application.DisplayAlerts = False
Application.ScreenUpdating = False

master = ThisWorkbook.Name

With Application.FileDialog(msoFileDialogOpen)
                .AllowMultiSelect = True
                .Title = "Locate Your Files"
                .Show
                
            n = .SelectedItems.Count
            
            For wb = 1 To n
            Path = .SelectedItems(wb)
            Workbooks.Open (Path)
            
            userfile = ActiveWorkbook.Name
            
            For Each Sheet In ActiveWorkbook.Worksheets
            If Sheet.Name = "Tracker" Then
            Sheet.Select
            Sheets("Tracker").Select
            Range("a1").Select
            Range(Selection, Selection.End(xlToRight)).Select
            Range(Selection, Selection.End(xlDown)).Select
            Selection.Copy
            'l_Row = Sheets("Tracker").Range("A1048576").End(xlUp).Row
            'This will find the last row of the tracker sheet
            'Range("A2:K" & l_Row).Copy
            'This code will copy all dat from tracker sheet
            Windows(master).Activate
            'This code will activate the master file where we will paste our data
            Sheets("Sheet1").Select
            Range("a1").Select
            'Range("a1048576").Select
            Selection.End(xlDown).Select
            Selection.End(xlDown).Select
            Selection.End(xlUp).Select
            ActiveCell.Offset(1, 0).Select
            
            'l_Dist = Sheets("Sheet1").Range("A1048576").End(xlUp).Row + 1
            'This code will find the next  blank row in the master file
            'Sheets("Sheet1").Range("A" & l_Dist).Select
            'This code will find the last non blank cell in the master file
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
            Range("b1048576").Select
            Selection.End(xlUp).Select
            Selection.End(xlToLeft).Select
            ActiveCell.Offset(1, 0).Select
            Range(Selection, Selection.End(xlDown)).Select
            Range(Selection, Selection.End(xlToRight)).Select
            Selection.Delete
            
            Range("a2").Select
            Selection.AutoFilter
            ActiveSheet.Range("$A$2:$L$41").AutoFilter Field:=1, Criteria1:= _
            "Employee Number"
            ActiveCell.Offset(20, 0).Range("A1").Select
            Range(Selection, Selection.End(xlToRight)).Select
            Range(Selection, Selection.End(xlDown)).Select
            Selection.EntireRow.Delete
            ActiveCell.Offset(-20, 0).Range("A1").Select
            Selection.AutoFilter
            Range("a2").Select
            
            Range(Selection, Selection.End(xlToRight)).Select
            Range(Selection, Selection.End(xlDown)).Select
            Selection.Font.Bold = True
            Selection.Columns.AutoFit
            With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    ActiveCell.Select
    
            
            Windows(userfile).Close savechanges:=False
            
            End If
        Next Sheet
    Next wb
    
End With

End Sub

在这段代码中，我想在这里编辑，就像我想连接单元格 A1 中的工作表名称一样，就像我在单元格 A1 中编写的那样，它将被视为其他工作簿中的工作表名称以查找工作表，然后它将从以下位置找到该名称：其他工作簿工作表如果我在单元格 A1 = 公司中写入，那么它将从其他工作簿工作表中找到公司工作表名称

**

If Sheet.Name = "Tracker" Then
            Sheet.Select
            Sheets("Tracker").Select
            Range("a1").Select

**

有人可以帮助我吗？

最新问题
© www.soinside.com 2019 - 2024. All rights reserved.