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

我正在使用本网站的数据表单： http://www.contextures.com/exceldataentryupdateform.html 请参阅工作簿下载“数据输入表单 - 添加/更新”。这是一个带有工作宏的简单数据输入表单，非常棒。此时只有在输入工作表中进行任何更改时才更新PartsData工作表。但是，我希望输入页面可以更新以“零件”字段（输入工作表中的D6）命名的其中一张工作表中的数据，例如“门”，“镜头”，“黑帽”。很显然，我可以用这些部分创建这些表单和相关数据。基于单元格值的参考工作表

我只想更新名称与输入页面中选择的“零件”字段相同的表单。

部分代码如下。我只是不知道如何调整它，因此 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

来源

2017-01-03 ewuchatka

非常感谢 – ewuchatka

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

来源

2017-01-03 14:09:16 tjb1

变化'范围（ “D6”）''来inputWks.Range（ “D6”）'或'inputWks。[D6]' – Rdster

非常感谢:) – ewuchatka

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

dim strWksTarget as string 
strWksTarget = sheets("Input").Range("D6") 
set historyWks = sheets(strWksTarget)

来源

2017-01-03 14:11:03

非常感谢这是非常有用！ – ewuchatka

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

回答

相关问题