0

私には難問がありますが、ExcelVBAを使用した方がうまくいくかどうかはわかりません。それについて考えると、VBAが最適に機能すると思いますが、それを機能させる方法がわかりません。

ブックに2つのページがあります。1つはフォーム、もう1つはデータベースです。フォームのプルダウンメニューで、フォームの残りの部分にデータを入力します。それは...私が望むのは、送信を押してフォームの値を変更できるようにすることです。新しいデータが古いデータを上書きします。

これは可能ですか？

これが私が話しているシートへのリンクです。

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

私が知る限り、これは私が主に望んでいることを実行しますが、それを希望どおりに機能させるために必要な場所に追加するために、どこで分割するかがわかりません。

私が言えるのはこれです。コピーして貼り付けますが、見つかった行にデータを貼り付け、その行の数を上書きしないようにします。

私がここに持っている2つのスクリプトで誰かがそれを可能にするのを手伝ってもらえますか？

4

2 に答える 2

0

マット、私が取る2つのアプローチがあります。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

もう1つは、Dictionaryオブジェクトを使用することです。キーに何が必要かわかりませんが、アイテムはデータシートの行である可能性があります。フォームの内容を変更するときは、キーを確認し、その項目（対応する行）を取得して、値を置き換える必要がある場所を判別します。

于 2012-04-26T18:19:21.253 に答える
0

テストされていませんが、開始する必要があります。フォームのセル アドレスと「データ」シートの列番号の間の mmapping を保持するために、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
于 2012-04-26T19:00:44.923 に答える