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 Range GradeType。

如果要将代码应用于其他下拉列表，可以更改此行：

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

并根据您的需要进行调整（不要忘记先创建一个新的命名范围）。

为了做到这一点，请看看：

什么是named range和how to define it
如何学习一些vba：Programming Excel和VBA: Basic Syntax and Examples Tutorial

VBA Excel编码扩展和修改

1 个答案: