在VBA中,用链接中的动态替换硬编码单元格引用

时间:2017-03-30 15:06:11

标签: vba excel-vba excel

我有两个工作簿一个"数据库"和另一个"来源"。我想要实现的是设置一个循环,该循环将通过" source"中的已知范围进行迭代。 wb并在"数据库"中创建链接。 "来源"中的数据wb = C7:C38。

有什么想法吗? 下面的代码是用于为链接提取单个值的代码 - 如何通过范围C7:C38进行循环?

Option Explicit

'**********Using ip address to link/locate folders in the the directory. 
Public Sub PullData()
Dim repDate As Date
Dim tmpFileStr As String
Dim tmpPathStr As String
Dim rowCtrLng As Long
Dim startRowCtrLng As Long
Dim stoptRowCtrLng As Long
Dim msgStr As String
Dim currentDate As Date
Dim stopDate
Dim fldName As String
Dim fName As String
Dim fDay As String

'On Error GoTo errHandler

    'Initialize row counter
    startRowCtrLng = 2
    'Get starting row for new data
    Do While ThisWorkbook.ActiveSheet.Range("B" & startRowCtrLng).Value <> ""
        startRowCtrLng = startRowCtrLng + 1
    Loop
rowCtrLng = startRowCtrLng
    'Assign current date to variable


    'Pause automatic calculation
    Application.Calculation = xlCalculationManual
    'Disable alerts
    Application.DisplayAlerts = False
repDate = Format(ThisWorkbook.Worksheets("Database").Range("A" &       rowCtrLng).Value, "mm/dd/yyyy")
currentDate = Date
fldName = Format(Year(Now), "0000")
fName = Format(Month(Now), "00")
fDay = Format(Day(Now), "0")



'Begin looping through date range
Do While repDate < currentDate

        tmpFileStr = ""
        tmpPathStr = ""


        'Determine if report exists
        tmpPathStr = "\\0.0.0.0\dept\Folder\Subfolder\" & fldName & "\"
        If Dir("\\0.0.0.0\dept\Folder\Subfolder\" & fldName & "\" & fName &  "-" & fldName & ".xls") <> "" Then
            tmpFileStr = fName & "-" & fldName & ".xls"

        Else
            tmpFileStr = ""
        End If

If tmpFileStr <> "" Then
            'build Links
            'Production Date
            ThisWorkbook.ActiveSheet.Range("A" & rowCtrLng).Value = repDate
            'Crush
             ThisWorkbook.ActiveSheet.Range("B" & rowCtrLng).Value = "='" & tmpPathStr & "[" & tmpFileStr & "]C vol'!$C$7"





End If
rowCtrLng = rowCtrLng + 1

repDate = ThisWorkbook.Worksheets("Database").Range("A" & rowCtrLng).Value
Loop

End Sub

&#39;

0 个答案:

没有答案