標題: [發問] 想請問下拉式選單做新增刪除修改 [打印本頁]

---

作者: bridetobe    時間: 2014-7-2 15:10     標題: 想請問下拉式選單做新增刪除修改

本帖最後由 bridetobe 於 2014-7-2 15:12 編輯

我利用工作表2的A欄來驗證資料抓到工作表的B欄來做下拉式選單
我拉下拉式選單按新增 可以輸入新增的資料
工作表2的A欄最下面也有出現新增的資料
但是卻顯示 1004目前程式碼他說應用程式或物件定義錯誤
然後下拉式選單又不見了 請問怎麼解決
目前程式碼

Private Sub Worksheet_Change(ByVal Target As Range) '
If ActiveCell = "新增" Then
   newitem = InputBox("請輸入新品名:")
   ActiveCell = newitem
   Sheets("清單").Range("A1").End(xlDown) = newitem
   Sheets("清單").Range("A1").End(xlDown).Offset(rowOffset:=1, columnOffset:=0) = "新增"
   Call y

End If
   
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
End Sub

Public Sub y()
    nowselect = ActiveCell.Address

   lastrow = Sheets("清單").Range("A1").End(xlDown).Row
       Columns("B:B").Select
       With Selection.Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:="=清單!$A$1:$A$" & lastrow
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = ""
        .ErrorMessage = ""
        .IMEMode = xlIMEModeNoControl
        .ShowInput = True
        .ShowError = True
    End With
    Range(nowselect).Select
End Sub


請大家救救我這個可憐的實習女大生:'(
本身不太會打程式了 不知何解
老闆給了作業刪除和修改 但是腦中真的沒概念
加上新增的地方不知道哪裡出錯
第一次來發問 如果有哪裡沒注意的 真的很抱歉
謝謝大家><

---

作者: Hsieh    時間: 2014-7-2 23:29

回復 1# bridetobe
在驗證所在的工作表模組

1. Private Sub Worksheet_Change(ByVal Target As Range)
   
2. Dim Rng As Range, newitem$, newlist$
   
3. If Target.Address Like "$B$*" Then '改變的儲存格為B欄
   
4.     If Target(1) = "新增" Then '若選擇新增
   
5.     Application.EnableEvents = False '關閉觸發事件程序
   
6.     newitem = InputBox("請輸入新增項目") '新增項目
   
7.        With 工作表2
   
8.        .[A1].End(xlDown).Offset(1) = newitem '清單底部新增項目
   
9.        newlist = "=" & .Range(.[A1], .[A1].End(xlDown)).Address(, , , 1) '新清單位址
   
10.        End With
    
11.      Set Rng = Target.SpecialCells(xlCellTypeSameValidation) '相同驗證儲存格
    
12.      With Rng.Validation
    
13.      .Delete '刪除驗證
    
14.      .Add xlValidateList, , , newlist '加入驗證
    
15.      End With
    
16.       Target = newitem '儲存格改為新值
    
17.     Application.EnableEvents = True '開啟觸發事件程序
    
18.      End If
    
19. End If
    
20. End Sub

複製代碼

---

作者: bridetobe    時間: 2014-7-3 10:10

回復 2# Hsieh


那請問一下 如果我是想在下拉式選單裡面選擇刪除
然後跳出輸入方塊讓使用者輸入在清單工作表A欄想要刪除的資料
然後在去搜尋有沒有在A欄裡出現 如果有就將A欄內的資料刪除
沒有的話就跳出尚未有此商品
這個的話要怎麼打會比較好

---

作者: Hsieh    時間: 2014-7-4 11:15

回復 3# bridetobe

試試看是否符合?

1. Private Sub Worksheet_Change(ByVal Target As Range)
   
2. Dim A As Range
   
3. If Target.Column <> 2 Then Exit Sub
   
4. With 工作表2
   
5.   ThisWorkbook.Names.Add "清單", "=OFFSET(" & .Name & "!$A$1,,,COUNTA(" & .Name & "!$A:$A))" '建立動態範圍名稱做為清單
   
6.   Set A = .Cells(.Rows.Count, 1).End(xlUp).Offset(1) '清單下一格
   
7. End With
   
8. With Target
   
9. Select Case .Value
   
10. Case "新增"
    
11.    newitem = InputBox("輸入新增項目")
    
12.    If IsError(Application.Match(newitem, [清單], 0)) Then A.Value = newitem Else MsgBox newitem & "已在清單內": Exit Sub
    
13.    With .EntireColumn.Validation
    
14.    .Delete
    
15.    .Add xlValidateList, , Formula1:="=" & [清單].Address(, , , 1)
    
16.    End With
    
17.    Target = newitem
    
18. Case "刪除"
    
19.    delitem = InputBox("輸入刪除項目")
    
20.    Set A = [清單].Find(delitem, lookat:=xlWhole)
    
21.    If A Is Nothing Then
    
22.       MsgBox delitem & "未在清單內"
    
23.       Else
    
24.       A.Delete xlShiftUp
    
25.    With .EntireColumn.Validation
    
26.    .Delete
    
27.    .Add xlValidateList, , Formula1:="=" & [清單].Address(, , , 1)
    
28.    End With
    
29.    End If
    
30. End Select
    
31. End With
    
32. End Sub

複製代碼

---

作者: bridetobe    時間: 2014-7-7 09:30

回復 4# Hsieh


可以!!!太感謝了!!!!!!謝謝謝謝!!!


可以再請問一個地方嗎
如果想要新增前的清單底部是這樣
[attach]18631[/attach]
新增完123後的清單底部是這樣
[attach]18632[/attach]

就是新增 刪除 修改都會各往下一格
我原本的程式碼是這樣打

1.    Sheets("清單").Range("A1").End(xlDown).Offset(rowOffset:=1, columnOffset:=0) = "新增"
   
2.       Sheets("清單").Range("A1").End(xlDown).Offset(rowOffset:=1, columnOffset:=0) = "刪除"
   
3.          Sheets("清單").Range("A1").End(xlDown).Offset(rowOffset:=1, columnOffset:=0) = "修改"

複製代碼

可是出來好像不太對 要怎麼改會比較好

不好意思我問題好多><

---

作者: Hsieh    時間: 2014-7-7 12:44

本帖最後由 Hsieh 於 2014-7-7 12:46 編輯

回復 5# bridetobe

1. Private Sub Worksheet_Change(ByVal Target As Range)
   
2. Dim A As Range
   
3. If Target.Column <> 2 Then Exit Sub
   
4. With 工作表2
   
5. ThisWorkbook.Names.Add "清單", "=OFFSET(" & .Name & "!$A$1,,,COUNTA(" & .Name & "!$A:$A),)"
   
6. With Range("B:B").Validation
   
7.    .Delete
   
8.    .Add xlValidateList, , , "=清單"
   
9. End With
   
10. Select Case Target.Value
    
11. Case "新增"
    
12. newitem = InputBox("輸入新增項目")
    
13. If Application.CountIf([清單], newitem) = 0 Then
    
14.    Set A = .Columns("A:A").Find("新增", lookat:=xlWhole)
    
15.    A.Insert xlShiftDown
    
16.    A.Offset(-1) = newitem
    
17.    Target = newitem
    
18. Else
    
19.    MsgBox "項目已存在清單內"
    
20. End If
    
21. Case "刪除"
    
22. delitem = InputBox("輸入刪除項目")
    
23. Set A = .Columns("A:A").Find(delitem, lookat:=xlWhole)
    
24. If A Is Nothing Then
    
25.    MsgBox delitem & "不存在清單內"
    
26.    Else
    
27.    A.Delete xlShiftUp
    
28. End If
    
29. Case "修改"
    
30. chitem = InputBox("輸入修改項目")
    
31. Set A = .Columns("A:A").Find(chitem, lookat:=xlWhole)
    
32. If A Is Nothing Then
    
33.    MsgBox chitem & "不存在清單內"
    
34.    Else
    
35.    A.Value = InputBox("輸入更正項目", , chitem)
    
36.    Target = A
    
37. End If
    
38. End Select
    
39. End With
    
40. With Range("B:B").Validation
    
41.    .Modify xlValidateList, , , "=清單"
    
42. End With
    
43. End Sub

複製代碼

---

作者: bridetobe    時間: 2014-7-7 12:51

回復 6# Hsieh


太感謝了!!!原來是這樣><
謝謝謝謝!!!

---

歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)