Question

下面附有一张表格，它将显示我在这里谈论的内容。但这正是我要找的。正如你在Final中的工作表中所看到的那样，所有列表都是一个很好的整齐顺序。

这是最终用户看到的。现在在某些情况下，当发送像Orig这样的文档时，我需要导入新行（如果有的话）。我注意到的是，尽管线条几乎完全相同，但客户评论却不同。

我们在最终报道上如何用红色输入评论，我无法复制和替换所有内容。我想要做的只是替换客户评论和所需的发货日期。

我想将PO，零件和描述作为参考点，然后用新的替换客户评论和所需的发货日期，即使没有变更，我仍然会喜欢将它替换为以防万一。

有人可以在VBA中向我显示一个可以执行该操作的脚本吗？

我想过用这样的东西来做这件事：

With Intersect(wsJL.UsedRange, wsJL.Columns("Q"))
        .AutoFilter 1, "<>Same"
        With Intersect(.Offset(2).EntireRow, .Parent.Range("B:U"))
            .Copy wsJAR.Cells(Rows.Count, "B").End(xlUp).Offset(1)
            .EntireRow.Delete
        End With
        .AutoFilter
    End With

但我遇到的问题是这不是一个EntireRow概念，而是两个单独的单元不在一起，否则对我来说会容易得多。

有没有办法使用这个脚本或其他类似的脚本来获得我想要的结果？

如果您能提供任何帮助，请提前感谢您的帮助。

Example Sheet

Answer 1

解决了它。

做了一些不同的事情，而不是我想要的，但这是最简单的答案。在最终标签的数据末尾添加了两个单元格：

对于O2-O4

=IFERROR(INDEX(Orig!$J$2:$J$4,MATCH(1,INDEX((Orig!$B$2:$B$4=$A2)*(Orig!$D$2:$D$4=$B2),0),0)),"")

对于P2-P4

=IFERROR(INDEX(Orig!$E$2:$E$4,MATCH(1,INDEX((Orig!$B$2:$B$4=$A2)*(Orig!$D$2:$D$4=$B2),0),0)),"")

然后创建了一个新脚本：

Option Explicit

Sub One()

    Dim wsFIN As Worksheet 'Final
    Dim wsORI As Worksheet 'Original
    Dim lastrow    
    Set wsFIN = Sheets("Final")
    Set wsORI = Sheets("Orig")

        lastrow = wsFIN.Range("B" & Rows.Count).End(xlUp).Row
        wsFIN.Range("O2:P" & lastrow).Copy wsFIN.Range("I2:J" & lastrow)
        wsFIN.Range("I2:J" & lastrow).Borders.Weight = xlThin
        wsFIN.Range("I2:J" & lastrow).Font.Size = 12
        wsFIN.Range("I2:J" & lastrow).Font.Name = "Calibri"

End Sub

它有效，但我希望有点清洁。这是最终结果。

Solution

Answer 2

如果我已经理解了你的需求，那么这个答案就没有一个简单的4行答案。但这是一个简单的90行答案。您需要使Enums与两张纸上的列定义保持一致，即“最终”和“原始”。您可能需要更改范围定义（工作表名称等）。您需要执行VBE菜单/工具/参考，并选中“Microsoft Scripting Runtime”以获取字典对象。对不起，如果它看起来很罗嗦，但应该很容易维护。

Option Explicit

' This is the definition of the columns on "Final" sheet
Enum final_record
    fr_partid
    fr_descr
    fr_vendorid
    fr_po
    fr_due
    fr_quantdue
    fr_status
    fr_orig
    fr_desired
    fr_comment
    fr_dayslate
    fr_pri
    fr_shoporder
    fr_remarks
    fr_end
End Enum

' This is the definition of the columns on "Orig" sheet
Enum orig_record
    or_po
    or_partid
    or_vendorid
    or_descr
    or_comment
    or_status
    or_quant
    or_balance
    or_orig
    or_requested
    or_end
End Enum

Sub UpdateDescrAndShipDate()
' Update comments and required ship date if matches po/partid/description.
' Else add a new row.
Dim lRows As Long, lRow As Long, rFinal As Range, rOrig As Range, sKey As String
Dim lTarget As Long, lNew As Long
Dim dictTarget As New Scripting.Dictionary

' Get Final rows into dict by key
    Set rFinal = Worksheets("Final").Range("A1")

    lRows = rFinal.Offset(65000, 0).End(xlUp).Row - rFinal.Row
    For lRow = 1 To lRows
        sKey = rFinal.Offset(lRow, fr_po).Value & "|" & _
               rFinal.Offset(lRow, fr_partid).Value & "|" & _
               rFinal.Offset(lRow, fr_descr).Value

        If Not dictTarget.Exists(sKey) Then
            dictTarget.Add sKey, lRow
        Else
            MsgBox "Invalid duplicate key? " & sKey
        End If
    Next
    lNew = lRows

' Run through Orig rows, and write to Orig based on key value
    Set rOrig = Worksheets("Orig").Range("A1")

    lRows = rOrig.Offset(65000, 0).End(xlUp).Row - rOrig.Row

    For lRow = 1 To lRows
        sKey = rOrig.Offset(lRow, or_po).Value & "|" & _
               rOrig.Offset(lRow, or_partid).Value & "|" & _
               rOrig.Offset(lRow, or_descr).Value

        If dictTarget.Exists(sKey) Then
' update
            lTarget = dictTarget(sKey)
            rFinal.Offset(lTarget, fr_comment).Value = rOrig.Offset(lRow, or_comment).Value
            rFinal.Offset(lTarget, fr_desired).Value = rOrig.Offset(lRow, or_requested).Value
        Else
' new row
            lNew = lNew + 1
            rFinal.Offset(lNew, fr_partid).Value = rOrig.Offset(lRow, or_partid)
            rFinal.Offset(lNew, fr_descr).Value = rOrig.Offset(lRow, or_descr)
            rFinal.Offset(lNew, fr_vendorid).Value = rOrig.Offset(lRow, or_vendorid)
            rFinal.Offset(lNew, fr_po).Value = rOrig.Offset(lRow, or_po)
            rFinal.Offset(lNew, fr_due).Value = rOrig.Offset(lRow, or_balance)
            rFinal.Offset(lNew, fr_quantdue).Value = rOrig.Offset(lRow, or_orig)
            rFinal.Offset(lNew, fr_status).Value = rOrig.Offset(lRow, or_status)
            rFinal.Offset(lNew, fr_orig).Value = ""
            rFinal.Offset(lNew, fr_desired).Value = rOrig.Offset(lRow, or_requested)
            rFinal.Offset(lNew, fr_comment).Value = rOrig.Offset(lRow, or_comment)
            rFinal.Offset(lNew, fr_dayslate).Value = ""
            rFinal.Offset(lNew, fr_pri).Value = ""
            rFinal.Offset(lNew, fr_shoporder).Value = ""
            rFinal.Offset(lNew, fr_remarks).Value = ""
        End If
    Next

End Sub

如果excel VBA中存在特定条件，我正在寻找替换单元格的方法

2 个答案: