VBA Excel編碼擴展和修改

Question

我已經爲使用Microsoft Excel的項目製作了一個評估系統，並且我希望這樣做，以便您可以使用相同的下拉菜單兩次。

輸入數據，然後讓電子表格保留該數據，並允許您覆蓋數據，但仍保留數據，但依賴於數據驗證下拉列表的值。

我已經爲此提供了代碼，但它只適用於電子表格的一部分。

我希望具有相同的效果，但使用不同的下拉菜單並影響電子表格的不同部分。

請隨時索要實際的電子表格或代碼。

這裏是代碼：

Option Explicit 

Public Sub Worksheet_Change(ByVal Target As Range) 

    ' This Sub is a standard VBA event handler. It is automatically invoked 
    ' every time the content of any cell in this worksheet changes 

    ' We are only interested if the user picks a different type of 
    ' grade. A named range GradeType was created to name this cell. 
    ' This allows the worksheet format to change without having to change 
    ' this code. 
    If Target.Address = Sheet1.[GradeType].Address Then 

     ' So the user doesn't see each invidual worksheet change as it happens 
     Application.ScreenUpdating = False 

     ' Where the current data will be saved to 
     ' These are in the first row, so the number of columns has 
     ' to be determined on the fly based on how much data is there 
     Dim FirstSaveTo As Range 
     Dim LastSaveTo As Range 

     ' Where the previous saved data will be restored from 
     Dim LastRestoreFrom As Range 
     Dim FirstRestoreFrom As Range 

     ' Use variables to define the relevant spaces in the Save sheet 
     ' depending on what grade type the user selected 
     If [GradeType] = "Attainment" Then 

     Set FirstSaveTo = Save.[AttainmentStart] 
     Set LastSaveTo = Save.[AttainmentEnd] 

     Set FirstRestoreFrom = Save.[EffortStart] 
     Set LastRestoreFrom = Save.[EffortEnd] 

     Else 

     Set FirstRestoreFrom = Save.[AttainmentStart] 
     Set LastRestoreFrom = Save.[AttainmentEnd] 

     Set FirstSaveTo = Save.[EffortStart] 
     Set LastSaveTo = Save.[EffortEnd] 

     End If 

     ' Save current data 

     ' Clear previously saved data 
     Save.Range(FirstSaveTo, LastSaveTo).EntireColumn.ClearContents 
     ' Copy current data 
     Sheet1.Range(Sheet1.[AssessmentFirst], Cells(Sheet1.UsedRange.Rows.Count, Sheet1.[AssessmentLast].Column)).Copy 
     ' Paste 
     FirstSaveTo.PasteSpecial xlPasteValues 

     ' Restore saved data 

     ' Clear current data 
     Sheet1.Range(Sheet1.[AssessmentFirst], Cells(Sheet1.UsedRange.Rows.Count, Sheet1.[AssessmentLast].Column)).ClearContents 
     ' Copy saved data 
     Save.Range(FirstRestoreFrom, Save.Cells(Save.UsedRange.Rows.Count, LastRestoreFrom.Column)).Copy 
     ' Paste saved data 
     Sheet1.[AssessmentFirst].PasteSpecial xlValues 

     ' Deselect copy area 
     Application.CutCopyMode = False 

     ' Put user back where he started 
     [GradeType].Select 

     Application.ScreenUpdating = True 

    End If 

End Sub 

Answer 1

你的代碼是越來越當前應用於Named RangeGradeType。

如果你想你的代碼應用到另一個下拉列表，你可以改變這一行：

If Target.Address = Sheet1.[GradeType].Address Then 

它適應任何你需要（別忘了先創建一個新的指定範圍）。

爲了做到這一點，看看：

• 什麼是named range和how to define it
• 如何可以學習一些VBA：Programming Excel和VBA: Basic Syntax and Examples Tutorial