使用.Formula运行时错误'1004'

时间:2015-08-14 10:48:58

标签: excel

我正在构建一个主excel文件,该文件旨在从存储在业务Dropbox文件中的许多其他excel文件中收集数据,并将它们放在主文件的第二张表中。我在我的本地计算机上构建了一个原始版本并且工作正常(path3变量)但是一旦我尝试根据不断变化的文件路径转换它(因为每个用户将拥有与其PC不同的路径)我得到了运行时间错误。 path2定义的公式是我一直试图使用的,但即使变量似乎保持正确的值(我通过写出值来测试它)它似乎无法移动数据,抛出上述错误并突出显示“rngdest.Formula = Chr(61)& path2”行。我真的不知道造成这种情况的原因是什么,我花了好几天尝试不同的方法,但没有用,所以任何想法,解决方案或链接已经解决(我花了很长时间搜索,但没有找到任何东西)非常感谢。 我已经包含了完整性的全部代码,我想我已经删除了我留下的大部分冗余代码,但可能还有一些仍然存在。如果您需要有关代码的任何说明,请告诉我。感谢任何潜在的帮助

Private Sub CommandButton2_Click()
Dim counter As Integer
Dim i As Long
Dim j As Long
Dim k As Long
Dim l As Long
Dim a As Integer
Dim z As Integer
Dim y As Integer
Dim p As Integer
Dim Names() As String
Dim Fix1() As String
Dim path3 As String
Dim path2 As String
Dim SheetName As String
Dim c As Range
Dim found As Range
Dim BookName As String
Dim var1 As String
Dim rngdest As Range
Dim rngsource As Range
Dim cell As String
Dim adjust As Integer
Dim adjust2 As Integer
Dim rngname As Range
Dim colNo As Integer
Dim fin As String
Dim fin2 As String
Dim fin3 As String
Dim comp As String
Dim teststring As String

Dim currentWb2 As Workbook
Set currentWb2 = ThisWorkbook
MsgBox "Excel will now update the sheet, please be patient as this can take             a few minutes. You will be notified once it is complete"

ReDim Fix1(1 To 4)
Fix1(1) = "A-F"
Fix1(2) = "G-L"
Fix1(3) = "M-R"
Fix1(4) = "S-Z"
counter = 0
With ActiveSheet
i = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
ReDim Names(1 To i, 1 To 4)
With ActiveSheet
For k = 1 To 4
For a = 2 To i

Names(a, k) = Cells(a, k).Value

Next a
Next k

End With
SheetName = "Analysis"
BookName = "Outcomes Final.xlsm"

For p = 1 To 4

fin2 = Split(Cells(, p).Address, "$")(1)
With ActiveSheet
l = .Cells(.Rows.Count, fin2).End(xlUp).Row
End With


For z = 1 To l
counter = counter + 1
fin = Split(Cells(, counter).Address, "$")(1)


currentWb2.Sheets("Sheet2").Range("" & fin & "1") = Names(z, p)

For y = 1 To 34


adjust = y + 1

cell = "$B$" & y & ""

If z = 1 Then
Else
teststring = GetPath()
teststring = teststring & "\Clients\"
path3 = "'C:\Users\Lewis\Documents\Outcomes\Floating Support\Clients\" &     Fix1(p) & "\" & Names(z, p) & "\[Outcomes Final.xlsm]Analysis'!" & cell & ""
path2 = teststring & Fix1(p) & "\" & Names(z, p) & "\Outcomes\[Outcomes Final.xlsm]Analysis'!" & cell & ""

End If

Set rngdest = currentWb2.Sheets("Sheet2").Range("" & fin & "" & adjust & "")

Set rngsource = Range("B" & y & "")

rngdest.Formula = Chr(61) & path2
Next y
Next z
Next p
currentWb2.Sheets("Sheet2").Columns(1).EntireColumn.Delete
currentWb2.Sheets("Sheet1").Range("A1:D35").Interior.ColorIndex = 0
For j = 1 To counter
fin3 = Split(Cells(, j).Address, "$")(1)

If currentWb2.Sheets("Sheet2").Range("" & fin3 & "35") = "1" Then

With currentWb2.Sheets("Sheet1").Range("A1:D35")
comp = currentWb2.Sheets("Sheet2").Range("" & fin3 & "1")

Set c = .Find(comp, LookIn:=xlValues)

If Not c Is Nothing Then

c.Interior.ColorIndex = 3


End If
End With
End If
Next j
MsgBox "The update is now complete, please click on sheet 2 to view the     data. All clients in red have not been properly completed"
End Sub

0 个答案:

没有答案