VBA-newby需要帮助。
我正在尝试让我的Project用户从另一个相同的文件更新他们的Excel文件。数据可以包括每种类型的数据,包括链接。
然而,我遇到两个问题:
(1)当到达包含指向外部文件的链接的某个单元格时,出现运行时错误13:类型不匹配。
(2)在我的表格中的某些位置,标题会被复制下来,而在其他位置则不会。
我对VBA比较陌生,不知道我的错误在哪里。任何帮助实现我的目标将不胜感激!
Application.ScreenUpdating = False
Dim wbInput As Workbook
Dim wbOutput As Workbook
Set wbOutput = ActiveWorkbook
Dim wsOutputDB As Worksheet
Set wsOutputDB = wbOutput.Worksheets("Meta DB")
Dim wsOutputCriteria As Worksheet
Set wsOutputCriteria = wbOutput.Worksheets("Criteria")
Dim wsOutputSkills As Worksheet
Set wsOutputSkills = wbOutput.Worksheets("Supplier Skills")
Dim strInput As String
Dim ID As Range
Dim IDcolumn As Range
Dim FindID As Range
Dim FindChange
Dim lRowInput As Integer
Dim lRowOutput As Integer
Dim NextRow As Integer
Dim lastcol As Integer
Dim lastcolOutput As Integer
Dim HeaderColumn As Range
Dim FindNewColItem As Range
strInput = Application.GetOpenFilename()
Set wbInput = Workbooks.Open(strInput)
wbInput.Worksheets("Meta DB").Visible = True
lRowInput = wbInput.Worksheets("Meta DB").Range("D" & Rows.Count).End(xlUp).row
lRowOutput = wsOutputDB.Range("D" & Rows.Count).End(xlUp).row
NextRow = wsOutputDB.Range("D" & Rows.Count).End(xlUp).row + 1
'1.0. - - ######################Copy all missing DB-Entries####################
With wbInput.Worksheets("Meta DB")
lastcol = .Cells(3, Columns.Count).End(xlToLeft).Column
LastColLetter = Split(wbInput.Worksheets("Meta DB").Cells(3, lastcol).Address, "$")(1)
lastcolOutput = wsOutputDB.Cells(3, Columns.Count).End(xlToLeft).Column
'1.1. - - Check if any new Variables have been added
For Each HeaderColumn In .Range("B3:" & LastColLetter & "3")
Set FindNewColItem = wsOutputDB.Range("B3:" & LastColLetter & "3").Find(What:=HeaderColumn, LookAt:=xlWhole)
If FindNewColItem Is Nothing Then
NewColLetter = Split(HeaderColumn.Address, "$")(1)
NextCol = lastcolOutput + 1
wbInput.Worksheets("Meta DB").Range(NewColLetter & "3").Copy Destination:=wsOutputDB.Range(NewColLetter & "3")
NextCol = NextCol + 1
End If
Next HeaderColumn
'1.2. - - Check if there are any new Entries to the Database
For Each ID In .Range("D4:D" & lRowInput)
Set FindID = wsOutputDB.Range("D4:D" & lRowOutput).Find(What:=ID, LookIn:=xlValues, LookAt:=xlWhole)
'1.2.1. - - If ID is a new Entry, simply add it to our file, else...
If FindID Is Nothing Then
NewIDrow = Split(ID.Address, "$")(2)
wbInput.Worksheets("Meta DB").Range("B" & NewIDrow & ":" & LastColLetter & NewIDrow).Copy Destination:=wsOutputDB.Range("B" & NextRow & ":" & LastColLetter & NextRow)
NextRow = NextRow + 1
Else
'1.2.2. - - If ID already exists, check for Updates of any Information
For Each IDcolumn In .Range("B" & ID.row & ":" & LastColLetter & ID.row)
Set FindChange = wsOutputDB.Range("B" & FindID.row & ":" & LastColLetter & FindID.row).Find(What:=IDcolumn)
If FindChange Is Nothing Then
ColLetter = Split(IDcolumn.Address, "$")(1)
wbInput.Worksheets("Meta DB").Range(ColLetter & ID.row).Copy Destination:=wsOutputDB.Range(ColLetter & FindID.row)
End If
Next IDcolumn
End If
Next ID
End With