0

我有一个困惑，我不知道使用 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

据我所知，这将做我最想做的事，但我似乎无法弄清楚在哪里分解它以将它添加到我需要让它按我想要的方式工作的地方。

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

有人可以通过我这里的两个脚本帮助实现这一点吗？

4

2 回答 2

0

马特，我会采取两种方法。第一个是使用 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 对象。我不确定您想要什么密钥，但该项目可能是数据表上的行。当您对表单上的内容进行更改时，请检查键并获取其项目（相应的行）以确定您需要替换值的位置。

于 2012-04-26T18:19:21.253 回答
0

未经测试，但应该让你开始。我添加了第三张表（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
于 2012-04-26T19:00:44.923 回答