Не удается выполнить в версии Excel 2010 - PullRequest
0 голосов
/ 26 апреля 2019

Я разработал код в версии Excel 2019.Я не могу выполнить код в версии Excel 2010, который используется членами моей команды.Я приложил код ниже, он хорошо работает для меня, но когда другие с версией Windows 2010 выполняются, он говорит об ошибке.

Я разработал код, который сравнивает два листа (sheet1 и sheet2) и уникальные записи, которые нашлив sheet2 копируются и вставляются в sheet3.

Option Explicit

Sub MoveDupes()
Application.ScreenUpdating = False
With ThisWorkbook
    ClearSheet .Worksheets("Steps2")
    FindDupes .Worksheets("Interface"), .Worksheets("Steps"), .Worksheets("Steps2")
End With
End Sub

Sub ClearSheet(ws As Worksheet)
'Clears data (but not header labels) from ws
Dim rg As Range
Set rg = ws.UsedRange
Set rg = rg.Offset(1, 0).Resize(rg.Rows.Count - 1, rg.Columns.Count)
rg.ClearContents
End Sub

Sub FindDupes(ws1 As Worksheet, ws2 As Worksheet, wsDest As Worksheet)
'Look for records in ws2 that isn't in ws1. Copy those rows to wsDest.
Dim frmla1 As String, frmla2 As String, frmlaTest As String
Dim rgCopy As Range, rg1 As Range, rg2 As Range, rgTest1 As Range, rgTest2 As Range
Dim n As Long, nCols As Long, nRows As Long
Set rg2 = ws2.Range("C6").CurrentRegion     'C6 must be a cell in data block
nCols = rg2.Columns.Count
nRows = rg2.Rows.Count
Set rg2 = Range(rg2.Cells(2, 1), rg2.Cells(nRows, nCols))

Set rg1 = ws1.Range("C6").CurrentRegion     'C6 must be a cell in data block
Set rg1 = Range(rg1.Cells(2, 1), rg1.Cells(rg1.Rows.Count, nCols))

Set rgTest1 = rg1.Columns(nCols + 1)
frmla1 = ConcatFormulaBuilder(rg1, 2, 4)
rgTest1.Cells(1).FormulaR1C1 = frmla1
rgTest1.FillDown
rgTest1.Formula = rgTest1.Value

Set rgTest2 = rg2.Columns(nCols + 1)
frmla2 = ConcatFormulaBuilder(rg2, 2, 4)
rgTest2.Cells(1).FormulaR1C1 = frmla2
rgTest2.FillDown
rgTest2.Formula = rgTest2.Value

frmlaTest = MatchFormulaBuilder(rgTest1)
rgTest2.Cells(1, 2).FormulaR1C1 = frmlaTest
rgTest2.Columns(2).FillDown
rgTest2.Columns(2).Formula = rgTest2.Columns(2).Value

Sorter rgTest2.Columns(2)
n = Application.CountIf(rgTest2.Columns(2), "Unique")
If n > 0 Then
    Set rgCopy = Range(rg2.Cells(1, 1), rg2.Cells(n, nCols))
    wsDest.UsedRange.Cells(2, 1).Resize(n, nCols).Value = rgCopy.Value
End If
rgTest1.EntireColumn.Delete
rgTest2.Resize(, 2).EntireColumn.Delete
End Sub

Function ConcatFormulaBuilder(rg As Range, FirstCol As Long, LastCol As Long)
Dim frmla As String
Dim i As Long, J As Long
J = rg.Column - 1
For i = FirstCol To LastCol
    frmla = frmla & "& ""|"" &RC" & (i + J)
Next
ConcatFormulaBuilder = "=" & Mid(frmla, 8)
End Function

Function MatchFormulaBuilder(rg As Range)
Dim addr As String
addr = "'" & rg.Worksheet.Name & "'!" & rg.Address(ReferenceStyle:=xlR1C1)
MatchFormulaBuilder = "=IF(ISNUMBER(MATCH(RC[-1]," & addr & ",0)),"""",""Unique"")"
End Function

Sub Sorter(SortColumn As Range)
'Sort target worksheet by SortColumn in alphabetical order
Dim SortRange As Range
Set SortRange = SortColumn.CurrentRegion
With SortColumn.Worksheet
    .Sort.SortFields.Clear
    .Sort.SortFields.Add2 key:=SortColumn, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With .Sort
        .SetRange SortRange
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End With
End Sub

Выполняется без ошибок в Excel 2019, но показывает ошибку в Excel 2010.

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...