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

据我所知，这将做我想要的主要内容，但我似乎无法弄清楚在哪里将它添加到我需要的位置以使其按照我想要的方式工作。< / p>

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

有人可以用我在这里的两个脚本帮助实现这个目标吗？

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编辑器中命名工作表：选择工作表并在属性网格中设置名称。

* 编辑： *如果要在Range 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

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

2 个答案: