基于单元格值的参考工作表

时间:2017-01-03 13:44:30

标签: database excel vba excel-vba

我使用本网站的数据表格: http://www.contextures.com/exceldataentryupdateform.html 请参阅工作簿下载"数据输入表单 - 添加/更新"。 它是一个带有工作宏的简单数据输入表单,非常棒。目前,只有在“输入”工作表中进行任何更改时,PartsData工作表才会更新。但是,我希望输入页面更新其中一个以"部件"之后命名的工作表中的数据。字段(输入表中的D6),例如" Door"," Lens"," Black cap"。显然,我可以用这些部分创建这些表格和相关数据。

我只想更新表格,其名称与" Parts"相同。在“输入”页面中选择的字段。

部分代码如下。我只是不知道如何调整它 Set historyWks = Worksheets("PartsData")在输入表格中生成单元格引用(D6)。其余的代码完全正常,所以它只是关于改变Set historyWks = Worksheets("PartsData")。有什么想法吗?

Sub UpdateLogWorksheet()

Dim historyWks As Worksheet
Dim inputWks As Worksheet

Dim nextRow As Long
Dim oCol As Long

Dim myCopy As Range
Dim myTest As Range

Dim lRsp As Long

Set inputWks = Worksheets("Input")
Set historyWks = Worksheets("PartsData")
oCol = 3 'order info is pasted on data sheet, starting in this column

'check for duplicate order ID in database
If inputWks.Range("CheckID") = True Then
  lRsp = MsgBox("Order ID already in database. Update record?", vbQuestion + vbYesNo, "Duplicate ID")
  If lRsp = vbYes Then
    UpdateLogRecord
  Else
    MsgBox "Please change Order ID to a unique number."
  End If
Else
  'cells to copy from Input sheet - some contain formulas
  Set myCopy = inputWks.Range("OrderEntry")

  With historyWks
      nextRow = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0).Row
  End With

  With inputWks
      'mandatory fields are tested in hidden column
      Set myTest = myCopy.Offset(0, 2)

      If Application.Count(myTest) > 0 Then
          MsgBox "Please fill in all the cells!"
          Exit Sub
      End If
  End With

  With historyWks
      'enter date and time stamp in record
      With .Cells(nextRow, "A")
          .Value = Now
          .NumberFormat = "mm/dd/yyyy hh:mm:ss"
      End With
      'enter user name in column B
      .Cells(nextRow, "B").Value = Application.UserName
      'copy the order data and paste onto data sheet
      myCopy.Copy
      .Cells(nextRow, oCol).PasteSpecial Paste:=xlPasteValues, Transpose:=True
      Application.CutCopyMode = False
  End With

  'clear input cells that contain constants
  ClearDataEntry
End If

End Sub

2 个答案:

答案 0 :(得分:0)

将该行从Set historyWks = Worksheets("PartsData")更改为Set historyWks = Worksheets(Range("D6").Value)这将使用D6中的值来设置工作表。

答案 1 :(得分:0)

声明一个新字符串以保存目标工作表的名称,然后将historyWks设置为字符串。

dim strWksTarget as string
strWksTarget = sheets("Input").Range("D6")
set historyWks = sheets(strWksTarget)
相关问题