基於單元格值的參考工作表

我正在使用本網站的數據表單： 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

基於單元格值的參考工作表

回答

相關問題