我有一个为Excel 2010编写的工具。它在2010年运行良好。但是，一个用户拥有Excel 2013，它似乎进入了无限循环。遗憾的是，我的PC上没有Excel 2013的副本，或者我还要进行更多调查。
该工具的基本前提是它具有来自数据库的数据行列表。前N列已由数据库填充，最后M列可由用户手动编辑。
工作表（让我们称之为＆＃34;目标＆＃34;工作表）有一个运行宏的更新按钮，它在PHP脚本上执行Workbook.Open（）。 PHP脚本查询数据库并获取更新的数据，并将其格式化为HTML表，其列与＆＃34; target＆＃34;相同。工作表，除了它显然没有手动输入的数据。 Workbook.Open（）方法将HTML转换为Excel工作表（让我们将其称为＆＃34; source＆＃34;工作表）。
在Workbook.Open（）之后，＆＃34;手册中的数据＆＃34;来自＆＃34;目标＆＃34;的列（M）工作表被复制到＆＃34;来源＆＃34;适当行中的工作簿（由＆＃34; STR＆＃34;列索引，这是一个唯一键）。
如果＆＃34; target＆＃34;中有任何行？不会出现在＆＃34;来源＆＃34;表格，他们被复制（通过.value调用 - 而不是sheet.copy）到＃34; Lost STRs＆＃34;片材。
然后，＆＃34;目标＆＃34;表格清除了所有数据，并且＆＃34;来源＆＃34;然后将工作表行复制到＆＃34; target＆＃34;片材。
我相信代码在尝试调用Worksheet.Copy方法时可能会失败。
以下是将数据从“源”表复制到“目标”表的代码部分。如果您尝试阅读它，请注意该工具的旧版本有两个目标表，一个＆＃34;已解决＆＃34;表格和＆＃34;未解决的＆＃34;片。 STR的状态决定了它将继续使用哪张表。然而，现在只有＆＃34;未解决＆＃34; STR正从数据库中删除，因此我们不会使用＆＃34; Resolved＆＃34;片材。
''
' Copies each row from the source workbook onto either the Unresolved or
' Resolved worksheet, depending on the status.
'
' @param sourceWorkbook The workbook from which to copy the rows
' @param unresolvedSheet The sheet that will contain the unresolved STRs
' @param di The database info, containing the STR column header text
'
Function CopyRows(sourceWorkbook As Workbook, unresolvedSheet As Worksheet, _
di As DatabaseInfo) As Variant()
Dim firstManualColNum As Long
Dim headerRow As Range
Dim lastAutoColNum As Long
Dim lastColNum As Long
Dim lastSourceRow As Long
Dim percentComplete As Integer
Dim r As Long
Dim resolvedSheet As Worksheet
Dim resolvedSheetRowNum As Long
Dim sourceFirstManualCell As Range
Dim sourceLastAutoCell As Range
Dim sourceLastCell As Range
Dim sourceHeaderRow As Range
Dim sourceSheet As Worksheet
Dim status As String
Dim statusColNum As Long
Dim sourceStrCell As Range
Dim targetAutoRange As Range
Dim targetManualRange As Range
Dim targetSheet As Worksheet
Dim targetSheetRowNum As Long
Dim unresolvedSheetRowNum As Long
Dim noResolvedSheet As Boolean
Dim errorStrs() As Variant
Dim errorStr As Variant
Set sourceSheet = sourceWorkbook.Sheets(1)
' The Resolved sheet is the sheet that has the same name as the unresolved
' sheet, except with the word "Unresolved" replaced with "Resolved".
Set resolvedSheet = getResolvedSheet(unresolvedSheet)
noResolvedSheet = resolvedSheet Is unresolvedSheet
' Get the row numbers on the Unresolved sheet and the Resolved sheet to
' start pasting.
Set headerRow = getHeaderRow(unresolvedSheet, di)
unresolvedSheetRowNum = headerRow.Row + 1
resolvedSheetRowNum = getHeaderRow(resolvedSheet, di).Row + 1
' We need to paste the database data differently than the manual data. For
' the database data, we paste the values and the number formats; for the
' manual data we paste all of it. Therefore, we need to find the first
' manual column index and the last database column index. We also get the
' very last column index.
firstManualColNum = headerRow.Find( _
What:=di.firstManualHeader, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows).Column
lastAutoColNum = firstManualColNum - 1
lastColNum = headerRow.Columns.Count
' Find the last row that contains data on the source sheet
lastSourceRow = getLastRow(sourceSheet)
' Find the status column so we can check the status of each STR, to
' determine which sheet to copy it to.
Set sourceHeaderRow = sourceSheet.Rows(1)
statusColNum = sourceHeaderRow.Find( _
What:="Status", _
LookAt:=xlWhole, _
SearchOrder:=xlByRows _
).Column
' Loop through the source rows and copy them to either the Unresolved sheet
' or the Resolved sheet.
For r = 2 To lastSourceRow
percentComplete = 100 * ((r - 1) / (lastSourceRow - 1))
Application.StatusBar = _
"Copying new data to " & unresolvedSheet.Name & _
" (" & percentComplete & "%) ..."
' Find the first and last database cells, and the first and last manual
' cells.
Set sourceStrCell = sourceSheet.Cells(r, 1)
Set sourceLastAutoCell = sourceSheet.Cells(r, lastAutoColNum)
Set sourceFirstManualCell = sourceSheet.Cells(r, firstManualColNum)
Set sourceLastCell = sourceSheet.Cells(r, lastColNum)
' Check the status of the STR and determine whether it's in the
' di.unresolvedStatuses array. If so, set the target sheet to the
' Unresolved sheet. Otherwise, set the target sheet to the Resolved
' sheet. Increment the appropriate target row counter.
If (InArray(di.unresolvedStatuses, sourceSheet.Cells(r, statusColNum))) Then
Set targetSheet = unresolvedSheet
targetSheetRowNum = unresolvedSheetRowNum
unresolvedSheetRowNum = unresolvedSheetRowNum + 1
Else
If noResolvedSheet Then
errorStr = sourceSheet.Range(sourceStrCell).Value2
ArrayPush errorStrs, errorStr
Set targetSheet = Nothing
Else
Set targetSheet = resolvedSheet
targetSheetRowNum = resolvedSheetRowNum
resolvedSheetRowNum = resolvedSheetRowNum + 1
End If
End If
If Not IsNothing(targetSheet) Then
' Set the range in which to paste the database information.
Set targetAutoRange = targetSheet.Range( _
targetSheet.Cells(targetSheetRowNum, 1), _
targetSheet.Cells(targetSheetRowNum, lastAutoColNum) _
)
' Set the range in which to paste the manual information.
Set targetManualRange = targetSheet.Range( _
targetSheet.Cells(targetSheetRowNum, firstManualColNum), _
targetSheet.Cells(targetSheetRowNum, lastColNum) _
)
' Copy the database information and paste only the values and number
' formats into the target range.
sourceSheet.Range(sourceStrCell, sourceLastAutoCell).Copy
targetAutoRange.PasteSpecial xlPasteValuesAndNumberFormats
' Adds back in the CRLF (ALT+ENTER) for cells that have multiple values
targetAutoRange.value = targetAutoRange.value
' Copy the manual information and paste it, formats and all, into the
' target range.
sourceSheet.Range(sourceFirstManualCell, sourceLastCell).Copy targetManualRange
End If
Next 'r
CopyRows = errorStrs
End Function