VBA函数返回值报错“对象不支持该属性”求修正方案

首先直接点出你的问题根源：GetMap函数的参数传递完全错误。看这行触发错误的代码：

from = GetRow(GetMap(wkb.Sheets(SourceName)))

GetMap函数定义要求传入的是rowName As String（字符串类型参数），但你这里传的是wkb.Sheets(SourceName)——这是一个工作表对象，VBA无法把对象转换成函数需要的字符串参数，自然就抛出了“对象不支持该属性”的错误。

接下来给你分步的修正方案，顺便优化代码冗余问题：

1. 修正参数传递逻辑 #

你需要明确GetMap要找的是工作表中的什么字符串值，比如：

• 如果是要获取工作表名称：

  from = GetRow(GetMap(wkb.Sheets(SourceName).Name))
  

• 如果是要获取工作表中某个特定单元格的值（比如A1单元格）：

  from = GetRow(GetMap(wkb.Sheets(SourceName).Range("A1").Value))
  

根据你的业务需求选择对应的字符串来源即可。

2. 合并冗余函数，减少重复代码 #

你的GetRow和GetMap功能高度重复，只是VLookup的列索引不同，完全可以合并成一个通用函数，避免冗余：

Function GetMapValue(rowName As String, returnCol As Integer) As String
    Dim refRange As Range: Set refRange = Sheet14.Range("Automation")
    On Error GoTo errProc
    GetMapValue = WorksheetFunction.VLookup(rowName, refRange, returnCol, False)
    Exit Function
errProc:
    If Err.Number = 1004 Then
        Err.Raise 5000, "GetMapValue", "Value '" & rowName & "' not found in mapping table!"
    Else
        Err.Raise Err.Number, Err.Source, Err.Description
    End If
End Function

调用时直接指定列索引就行：

' 原GetMap功能：获取映射表第1列的值
Dim mapKey As String
mapKey = GetMapValue(targetString, 1)
' 原GetRow功能：获取映射表第2列的值
from = GetMapValue(mapKey, 2)

3. 修复其他潜在问题 #

• 变量声明不完整：Header里的Dim from, dest As String其实只把dest声明为String，from是默认的Variant类型，改成Dim from As String, dest As String避免类型问题。
• 进度值未初始化：completed变量没有初始值，会导致第一次进度条显示异常，在Header开头加上Dim completed As Double: completed = 0。
• 工作表引用显式化：Call CopyRange(Sheets(SourceName)...没有指定工作簿，容易混淆当前工作簿和打开的目标工作簿，改成wkb.Sheets(SourceName)更安全。

修正后的关键代码片段 #

Sub Header()
    Dim DestName As String, SourceName As String, MyDir As String
    Dim steps As Integer, ref As Integer
    Dim Wb As Workbook, wkb As Workbook
    Dim lnCol As Long, last As Long, j As Long
    Dim from As String, mapKey As String
    Dim completed As Double: completed = 0 ' 初始化进度值
    
    DestName = "Data Cost Estimate" 'Name of destination sheet
    SourceName = "EST Actuals" 'Name of Source sheet
    MyDir = "\Path\" 'Default directory path"
    steps = 22 'Number of rows copied
    ref = 13 'row in Estimate sheet in which 'Grand Total' is present
    Set Wb = ThisWorkbook
    
    ' 关闭Excel特性加速运行
    Application.DisplayAlerts = False
    ActiveSheet.DisplayPageBreaks = False
    Application.Calculation = xlCalculationManual
    
    Dim MyFile As String
    MyFile = Dir(MyDir & "Estimate.xlsm") 'change file extension
    ChDir MyDir
    Set wkb = Workbooks.Open(MyDir + MyFile, UpdateLinks:=0)
    
    'Find the last non-blank cell in row 1
    lnCol = wkb.Sheets(SourceName).Cells(ref, Columns.Count).End(xlToLeft).Column
    last = lnCol - 1
    MsgBox "Last but one column is: " & last
    
    ' 修正参数传递：这里假设是获取工作表名称，按需调整
    mapKey = GetMapValue(wkb.Sheets(SourceName).Name, 1)
    from = GetMapValue(mapKey, 2)
    
    j = Wb.Sheets(DestName).Cells(1, 1).EntireColumn.Find( _
        What:=from, LookIn:=xlValues, LookAt:=xlPart, _
        SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False).Row
    
    Call CopyRange(wkb.Sheets(SourceName).Range("C18:R18"), Wb.Sheets(DestName).Cells(j, 2), completed)
    completed = completed + (100 / steps)
    Call CopyRange(wkb.Sheets(SourceName).Range("C20:R20"), Wb.Sheets(DestName).Cells(j, 2), completed)
    completed = completed + (100 / steps)
    Call CopyRange(wkb.Sheets(SourceName).Range("C27:R27"), Wb.Sheets(DestName).Cells(j, 2), completed)
    completed = completed + (100 / steps)
    
    wkb.Close SaveChanges:=False ' 明确是否保存目标工作簿
    MyFile = Dir()
    
    ' 恢复Excel特性
    Application.DisplayAlerts = True
    Application.Calculation = xlCalculationAutomatic
    ActiveSheet.DisplayPageBreaks = True
End Sub

内容的提问来源于stack exchange，提问作者shettyrish