Question

我在SharePoint中有一个主工作簿和20个其他工作簿。目前我使用以下代码从已关闭的工作簿中检索单个单元格值，该工作簿非常正常。

Sub Example()

Dim wbPath As String, wbName As String
Dim wsName As String, cellRef As String
Dim Ret As String

wbPath = "http://*****/2014/"

wbName = "overview 2014.xlsm"
wsName = "Sheet1"
cellRef = "E2"

Ret = "'" & wbPath & "[" & wbName & "]" & _
      wsName & "'!" & Range(cellRef).Address(True, True, -4150)

ActiveWorkbook.Worksheets("Sheet1").Range("A4").Value = ExecuteExcel4Macro(Ret)

End Sub

现在我实际上想要获得需要从SharePoint的所有工作簿复制到主工作簿范围A5，A6，A7，A8等的相同单元格值。

有人可以帮助我或者提示我如何从同一个共享点位置从不同的已关闭工作簿中复制相同的单元格值吗？

我实际上已尝试使用以下代码用于其他工作簿并且工作正常，但只是想知道是否还有其他更智能的方法来减少代码中的行数？

 wbPath = "http://*****/2014/"

 wbName = "overview 2014.xlsm"
 wsName = "Sheet1"
 cellRef = "E2"

 Ret = "'" & wbPath & "[" & wbName & "]" & _
      wsName & "'!" & Range(cellRef).Address(True, True, xlR1C1)

ActiveWorkbook.Worksheets("sheet1").Range("A4").Value = ExecuteExcel4Macro(Ret)

wbName = "workbook2.xlsm"
wsName = "sheet1"
cellRef = "E2"

Ret = "'" & wbPath & "[" & wbName & "]" & _
      wsName & "'!" & Range(cellRef).Address(True, True, -4150)

ActiveWorkbook.Worksheets("sheet1").Range("A5").Value = ExecuteExcel4Macro(Ret)

wbName = "workbook3.xlsm"
wsName = "sheet1"
cellRef = "E2"

Ret = "'" & wbPath & "[" & wbName & "]" & _
      wsName & "'!" & Range(cellRef).Address(True, True, -4150)

ActiveWorkbook.Worksheets("sheet1").Range("A6").Value = ExecuteExcel4Macro(Ret)

wbName = "workbook4.xlsm"
wsName = "sheet1"
cellRef = "E2"

Ret = "'" & wbPath & "[" & wbName & "]" & _
      wsName & "'!" & Range(cellRef).Address(True, True, -4150)

ActiveWorkbook.Worksheets("sheet1").Range("A7").Value = ExecuteExcel4Macro(Ret)

wbName = "workbook5.xlsm"
wsName = "sheet1"
cellRef = "E2"

Ret = "'" & wbPath & "[" & wbName & "]" & _
      wsName & "'!" & Range(cellRef).Address(True, True, -4150)

ActiveWorkbook.Worksheets("sheet1").Range("A8").Value = ExecuteExcel4Macro(Ret)

wbName = "workbook6.xlsm"
wsName = "sheet1"
cellRef = "E2"

Ret = "'" & wbPath & "[" & wbName & "]" & _
      wsName & "'!" & Range(cellRef).Address(True, True, -4150)

ActiveWorkbook.Worksheets("sheet1").Range("A9").Value = ExecuteExcel4Macro(Ret)

wbName = "Workbook7.xlsm"
wsName = "sheet1"
cellRef = "E2"

Ret = "'" & wbPath & "[" & wbName & "]" & _
      wsName & "'!" & Range(cellRef).Address(True, True, -4150)

ActiveWorkbook.Worksheets("sheet1").Range("A10").Value = ExecuteExcel4Macro(Ret)

wbName = "workbook8.xlsm"
wsName = "sheet1"
cellRef = "E2"

Ret = "'" & wbPath & "[" & wbName & "]" & _
      wsName & "'!" & Range(cellRef).Address(True, True, -4150)

ActiveWorkbook.Worksheets("sheet1").Range("A11").Value = ExecuteExcel4Macro(Ret)

wbName = "workbook9.xlsm"
wsName = "sheet1"
cellRef = "E2"

Ret = "'" & wbPath & "[" & wbName & "]" & _
      wsName & "'!" & Range(cellRef).Address(True, True, -4150)

ActiveWorkbook.Worksheets("sheet1").Range("A13").Value = ExecuteExcel4Macro(Ret)

wbName = "workbook10.xlsm"
wsName = "sheet1"
cellRef = "E2"

Ret = "'" & wbPath & "[" & wbName & "]" & _
      wsName & "'!" & Range(cellRef).Address(True, True, -4150)

ActiveWorkbook.Worksheets("sheet1").Range("A14").Value = ExecuteExcel4Macro(Ret)

Answer 1

要减少代码，我会使用附加功能：

Function getValue(wbPath As String, wbName As String, wsName As String, cellRef As String)
    Dim Ret As String
    Ret = "'" & wbPath & "[" & wbName & "]" & _
            wsName & "'!" & Range(cellRef).Address(True, True, -4150)
    getValue = ExecuteExcel4Macro(Ret)
End Function

然后像这样调用它：

Sub test()
    Dim i As Integer, wbs

    wbs = Array("overview 2014.xlsm", "workbook2.xlsm", _
                "workbook3.xlsm", "workbook4.xlsm", _
                "workbook5.xlsm", "workbook6.xlsm", _
                "workbook7.xlsm", "workbook8.xlsm", _
                "workbook9.xlsm", "workbook10.xlsm")
    ' LBound(wbs) = 0
    For i = LBound(wbs) To UBound(wbs)
        ActiveWorkbook.Worksheets("sheet1").Range("A4").Offset(i).Value = _
            getValue("http://*****/2014/", CStr(wbs(i)), "sheet1", "E2")
    Next i
End Sub

从共享点中的不同已关闭工作簿复制单个单元格值

1 个答案: