Excel VBA还是不VBA，如果两个单元格之间不同，请替换文本

Question

我有一个难题，我不知道使用excel VBA是否会更好。 考虑这一点，我相信VBA会最好地工作，但是我不知道如何使它工作。

我在工作簿中有两页，一个是表单，另一个是数据库，我想从表单的下拉菜单填充表单的其余部分。 它确实...我想要的是能够更改表单提交的值，新数据将覆盖旧数据。

这可能吗？

这是我正在谈论的工作表的链接。

http://dl.dropbox.com/u/3327208/Excel/Change.xlsx

这是我现在正在使用的脚本...它需要处理工作表，将所有内容复制到一行中，然后将其移至“ NCMR数据”选项卡，然后从原始工作表中清除新行上的数据。

该代码从技术上讲可以工作，但是我需要做的是使用相同的概念，但是与其在工作表的末尾创建新行，还不如找到原始行并将数据从B替换为U到任何行原来在。

我知道这是可能的，我只是不知道如何。

 'Copy Ranges Variable
    Dim c As Variant

    'Paste Ranges Variable
    Dim p As Range

    'Setting Sheet
    Set wsInt = Sheets("Form")
    Set wsNDA = Sheets("Data")
    Set p = wsInt.Range("A14")

    With wsInt
        c = Array(.Range("B11"))
    End With

    For i = LBound(c) To UBound(c)
        p(i + 1).Value = c(i).Value
    Next

    With wsNDA
        Dim Lastrow As Long

        Lastrow = .Range("B" & Rows.Count).End(xlUp).Row + 1

        wsInt.Rows("14").Copy

        With .Rows(Lastrow)
            .PasteSpecial Paste:=xlPasteFormats
            .PasteSpecial Paste:=xlPasteValues
            .Interior.Pattern = xlNone
        End With

        With .Range("A" & Lastrow)
            If Lastrow = 3 Then
                .Value = 1
            Else
                .Value = Val(wsNDA.Range("A" & Lastrow - 1).Value) + 1
            End If

            .NumberFormat = "0#######"
        End With
    End With
End Sub

我发现此代码：

Sub CopyTest()
Dim selrow As Range, rngToCopy As Range

With Worksheets("PD DB")
    Set selrow = .Range("B:B").Find(.Range("BA1").Value)
    'find the cell containing the value
    Set rngToCopy = Union(selrow.Offset(0, 9), selrow.Offset(0, 12))
    'use offset to define the ranges to be copied
    rngToCopy.Copy Destination:=Worksheets("Edit Sheet").Range("B50")
    'copy and paste (without Select)
End With

End Sub

据我所知，它将完成我最想要的工作，但是我似乎无法弄清楚在哪里分解它，并在需要的地方添加它，以使其按我希望的方式工作。

我可以说的是，它将复制并粘贴，但是我想确保将数据粘贴到找到的行中，而不覆盖所述行的数量。

有人可以帮我实现这里的两个脚本吗？

Answer 1

马特，我有两种方法。 第一个是使用find（），它返回一个范围对象，然后附加“ .row”，以便您可以修改Sheet2上的行（我认为是wsNDA）。 您可能要测试find（）不返回Nothing。

Dim foundRow as Long
Dim foundRng as Range

set foundRng = wsNDA.find(wsInt.Range("B11").Value, ...)
If Not foundRng is Nothing Then
  foundRow = foundRng.row
End If

'method without check: foundRow = wsNDA.find(wsInt.Range("B11").Value, ...).Row

另一种是使用Dictionary对象。 我不确定您想要的键是什么，但该项可能是数据表上的行。 当您对表单上的内容进行更改时，请对照该键并抓住其项（对应的行）以确定您需要在何处替换值。

Answer 2

未经测试，但应该可以帮助您入门。 我添加了第3个工作表（shtMap），以保存表单上单元格地址和“数据”工作表上的列号之间的映射。 直接在VB编辑器中命名工作表很有用：选择工作表并在属性网格中设置名称。

* 编辑： *如果要在从范围AG3的列表中选择记录ID时触发传输，则将此代码放在该工作表的代码模块中：

Private Sub Worksheet_Change(ByVal Target As Range)

Static bProcessing As Boolean
Dim rng As Range

    If bProcessing Then Exit Sub
    Set rng = Target.Cells(1)
    If Not Application.Intersect(rng, Me.Range("AG3")) Is Nothing Then
        bProcessing = True
        'this is where you call your macro to transfer the record
        bProcessing = False
    End If

End Sub

您可以使用以下方式进行传输：

Public Enum XferDirection
    ToForm = 1
    ToDataSheet = 2
End Enum

Sub FetchRecord()
    TransferData XferDirection.ToForm
End Sub

Sub SaveRecord()
    TransferData XferDirection.ToDataSheet
End Sub


Sub TransferData(Direction As XferDirection)

    Dim rngMap As Range, rw As Range, f As Range, dataCell As Range
    Dim formCell As Range, dataCol As Long, dataRow As Long
    Dim sId As String

    sId = shtForm.Range("AG3").Value
    Set f = shtData.Columns(1).Find(sId, LookIn:=xlValues, lookat:=xlWhole)
    If Not f Is Nothing Then
        dataRow = f.Row
    Else
        'what do you want to do here?
        '  record doesn't exist on data sheet
        MsgBox "Record '" & sId & "' not found on '" & shtForm.Name & "' !"
        Exit Sub
    End If

    Set rngMap = shtMap.Range("A2:B10")

    For Each rw In rngMap.Rows
        'the cell on the edit form
        Set formCell = shtForm.Range(rw.Cells(1).Value)
        'column # on datasheet
        Set dataCell = shtData.Cells(dataRow, rw.Cells(2).Value)

        If Direction = XferDirection.ToDataSheet Then
            dataCell.Value = formCell.Value
        Else
            formCell.Value = dataCell.Value
        End If
    Next rw

End Sub