如何更新阵列之间的补偿数据?

时间:2019-04-18 18:10:37

标签: excel vba

我有一本工作簿,两张纸(第一张和第二张)。工作表1的A:E列(TSR =目标薪资范围)

Job Code job title TSR min TSR mid TSR max

10001 job 1 55k 60k 65K

10003 job 3 65k 70k 75K

10005 job 3 75k 80k 85K

在工作表2中,我仅更新了两项工作的数据:

Job Code job title TSR min TSR mid TSR max

10001 job 1 65k 70k 75K

10005 job 3 85k 90k 95K

基于Sheet2,我只想更新工作1和3的C:E列中的数字,而不更改工作2的薪水范围。

这是我尝试过的代码,但在此行上没有出现下标错误:Set varSheetB = wbkA.Sheets(2),而且我一般不认为我在那儿(为什么我要伸出手来)。

Option Explicit

Sub test()

Dim wbkA As Workbook
Dim varSheetA As Variant, varSheetB As Variant
Dim strRangeToCheck As String
Dim iRow As Long
Dim iCol As Long 'I'll want to check for differing values between columns C:E

Set wbkA = ThisWorkbook

Set varSheetA = wbkA.Sheets(1)
Set varSheetB = wbkA.Sheets(2)

strRangeToCheck = "A2:E3000"

varSheetA = Worksheets("Sheet1").Range(strRangeToCheck)
varSheetB = Worksheets("Sheet2").Range(strRangeToCheck)

For iRow = LBound(varSheetA, 1) To UBound(varSheetA, 1)

    For iCol = LBound(varSheetA, 2) To UBound(varSheetA, 2)

        If varSheetA(iRow, iCol) <> varSheetB(iRow, iCol) Then '
           varSheetA(iRow, iCol) = varSheetB(iRow, iCol)
        Else
            'do nothing
        End If

    Next iCol

Next iRow

End Sub

如有必要,我将链接屏幕截图,但请想象两个都从A1开始(带有标题)

worksheet

此表显示了您的代码更新的OG内容,但随后出现了薪水稍高的迭代,也需要更新。

1 个答案:

答案 0 :(得分:2)

我对您的代码进行了一些更改,以清理代码并使代码更高效。首先,由于Sheet2包含所有更改,因此我们将在该工作表上循环并在工作表1中搜索值。这效率更高,因为它不会浪费循环遍历工作表1中没有任何更改的单元格的操作。

此外,我使范围动态化,因此您不必在所有情况下都将范围限制为“ A2:E3000”。如果我理解正确,sheet2将是sheet1的子集,因此在某些情况下它将具有较少的行。没有理由遍历空白行。

最后,我使用Match函数搜索匹配项。请记住,该函数返回相对于范围的位置。因此,如果要在Range(“ A5:A10”)中搜索匹配项,并且在单元格A5中找到了匹配项,则该函数将返回1(而不是5)。这就是为什么我要偏移fndRow变量。

让我知道这是否对您有用,或者您还有其他问题。

 Sub Test()
    Dim wbk As Workbook
    Dim wsA As Worksheet
    Dim wsB As Worksheet
    Dim rngA As Range
    Dim rngB As Range
    Dim rIterator As Range
    Dim fndRow As Long

    Set wbk = ThisWorkbook
    Set wsA = wbk.Sheets("Sheet1")
    Set wsB = wbk.Sheets("Sheet2")

    'CurrentRegion should work to bring in the entire
    'necessary range so long as it is contiguous data
    Set rngA = wsA.Range(wsA.Range("A2"), wsA.Range("A2").End(xlDown))
    Set rngB = wsB.Range(wsB.Range("A2"), wsB.Range("A2").End(xlDown))

    For Each rIterator In rngB
        On Error Resume Next
        fndRow = Application.Match(rIterator.Value, rngA, 0) + _
            rngA.Range("A1").Row - 1
        If Err.Number <> 0 Then
            'What happens if it isn't found?
        Else
            wsA.Cells(fndRow, 3).Value = rIterator.Offset(, 2).Value
            wsA.Cells(fndRow, 4).Value = rIterator.Offset(, 3).Value
            wsA.Cells(fndRow, 5).Value = rIterator.Offset(, 4).Value

            wsA.Cells(fndRow + 1, 3).Value = rIterator.Offset(, 2).Value * 1.1
            wsA.Cells(fndRow + 1, 4).Value = rIterator.Offset(, 3).Value * 1.1
            wsA.Cells(fndRow + 1, 5).Value = rIterator.Offset(, 4).Value * 1.1

            wsA.Cells(fndRow + 2, 3).Value = rIterator.Offset(, 2).Value * 1.2
            wsA.Cells(fndRow + 2, 4).Value = rIterator.Offset(, 3).Value * 1.2
            wsA.Cells(fndRow + 2, 5).Value = rIterator.Offset(, 4).Value * 1.2

            '.... Repeat for all rows
        End If

        Err.Clear

    Next rIterator

 End Sub