0
我已經爲使用Microsoft Excel的項目製作了一個評估系統，並且我希望這樣做，以便您可以使用相同的下拉菜單兩次。VBA 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
是的，請提供碼。您可以編輯您的問題並將其粘貼在底部。 – PowerUser 2011-12-13 22:40:50
@PowerUser，這裏是表單的代碼，代碼有效，但我想修改它，是否可以附加我的電子表格？或者可能直接發郵件給你？我需要它會更容易理解。 – 2011-12-13 22:52:03