Я создал систему оценки для проекта с использованием 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