本帖最后由 daxindianqi 于 2016-6-11 15:01 编辑
求助:
数据刷新的作用为以D列为索引,查找本表目录下的“data.xls”文件中相同意义的值并赋值在本表相应单元内;
问题:如D列有重复项,则执行数据刷新后只能在最下部所在行的单元格才能引用。
例如:D4与D9有重复,执行数据刷新后只能在D9单元格所在的行引用,正确的引用是所有D列存在的数据都要被引用。 Private Sub CommandButton1_Click()
Dim Arr, myPath$, myName$, Arr1, Myr&, d, Myr1&, m&
Application.ScreenUpdating = False
Set d = CreateObject("Scripting.Dictionary")
Sheets("分项报价").Activate
Myr = Cells(Rows.Count, 4).End(xlUp).Row
Range("e4:m" & Myr).ClearContents
Arr = Range("a4:m" & Myr)
For i = 1 To UBound(Arr)
If Arr(i, 4) <> "" Then d(Arr(i, 4)) = i
Next
myPath = ThisWorkbook.Path & "\"
myName = Dir(myPath & "data.xls")
With GetObject(myPath & myName)
With .Sheets("data")
Myr1 = .Cells(.Rows.Count, 4).End(xlUp).Row
Arr1 = .Range("a1:J" & Myr1) '
For i = 1 To UBound(Arr1)
If d.Exists(Arr1(i, 4)) Then '
m = d(Arr1(i, 4))
Arr(m, 2) = Arr1(i, 2)
Arr(m, 3) = Arr1(i, 3)
Arr(m, 5) = Arr1(i, 5)
Arr(m, 7) = Arr1(i, 7)
Arr(m, 9) = Arr1(i, 10)
End If
Next
End With
.Close False
End With
Range("a4:m" & Myr) = Arr
For i = 1 To UBound(Arr)
If Arr(i, 2) <> "" Then Cells(i + 3, 8) ="=rc[-1]*rc[-2]"
If Arr(i, 2) <> "" Then Cells(i + 3, 10) ="=rc[-3]*rc[2]"
If Arr(i, 2) <> "" Then Cells(i + 3, 11) ="=rc[-1]*rc[1]"
Next
Application.ScreenUpdating = True
End Sub
代码如下: - Private Sub CommandButton1_Click()
- Dim Arr, myPath$, myName$, Arr1, Myr&, d, Myr1&, m&
- Application.ScreenUpdating = False
- Set d = CreateObject("Scripting.Dictionary")
- Sheets("分项报价").Activate
- Myr = Cells(Rows.Count, 4).End(xlUp).Row
- Range("e4:m" & Myr).ClearContents
- Arr = Range("a4:m" & Myr)
- myPath = ThisWorkbook.Path & ""
- myName = Dir(myPath & "data.xls")
- With GetObject(myPath & myName)
- With .Sheets("data")
- Myr1 = .Cells(.Rows.Count, 4).End(xlUp).Row
- Arr1 = .Range("a1:J" & Myr1) '
- For i = 1 To UBound(Arr1)
- d(Arr1(i, 4)) = i
- Next
- End With
-
- End With
- For i = 1 To Myr - 3
- If d.Exists(Arr(i, 4)) Then
- m = d(Arr(i, 4))
- Arr(i, 2) = Arr1(m, 2)
- Arr(i, 3) = Arr1(m, 3)
- Arr(i, 5) = Arr1(m, 5)
- Arr(i, 7) = Arr1(m, 7)
- Arr(i, 9) = Arr1(m, 10)
- End If
- Next
- Range("a4:m" & Myr) = Arr
- For i = 1 To UBound(Arr)
- If Arr(i, 2) <> "" Then Cells(i + 3, 8) = "=rc[-1]*rc[-2]"
- If Arr(i, 2) <> "" Then Cells(i + 3, 10) = "=rc[-3]*rc[2]"
- If Arr(i, 2) <> "" Then Cells(i + 3, 11) = "=rc[-1]*rc[1]"
- Next
- Application.ScreenUpdating = True
- End Sub
复制代码
|