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