標題: [發問] 請各位高手協助,謝謝您 [打印本頁]

---

作者: usana642    時間: 2012-6-25 19:28     標題: 請各位高手協助,謝謝您

想請各位高手協助,需求如下:
我想寫一個有關於每日菜單設計表,材料有a,b,c,d,e...等數種,每天各種材料加總為15
例如
         A     B C D E F G H I J K -欄
列1  NO.1  a 2 c  2 b 2  e 2 f 3  
列2  NO.2  c 2 b  2 f 3  e 2 a 2  -->當我這一列輸入完成後,會和NO.1的資料比對,會跳出警告說菜單已重複
列3  NO.3  c 2 b  2 f 3  e 2 a 2  -->當我這一列輸入完成後,會和NO.1和NO.2的資料比對,無重複,則不必跳出警告

以上這是我想要完成的菜單,可以在Sheet1輸入資料,再和Sheet2的歷史菜單比對,懇請各位高手幫我這個大忙,謝謝您

---

作者: register313    時間: 2012-6-25 23:17

回復 1# usana642

工作表模組

1. Private Sub Worksheet_Change(ByVal Target As Range)
   
2. If Target.Column > 11 Then Exit Sub
   
3. Set d = CreateObject("Scripting.Dictionary")
   
4. LR = [A65536].End(xlUp).Row
   
5. For I = 1 To LR - 1
   
6.    For J = 2 To 10 Step 2
   
7.      d(Cells(I, J).Value) = ""
   
8.    Next J
   
9.    If d.exists(Cells(LR, 2).Value) And d.exists(Cells(LR, 4).Value) And d.exists(Cells(LR, 6).Value) And d.exists(Cells(LR, 8).Value) And d.exists(Cells(LR, 10).Value) Then
   
10.      MsgBox "與第" & I & "列重覆"
    
11.    End If
    
12.    d.RemoveAll
    
13. Next I
    
14. End Sub

複製代碼

---

作者: usana642    時間: 2012-6-26 16:15

回復 2# register313


    謝謝register313熱心協助,我先試看看,謝謝您

---

作者: usana642    時間: 2012-6-26 19:02

回復 2# register313


    可以正常執行了,謝謝您

---

作者: Hsieh    時間: 2012-6-26 22:52

回復 1# usana642

1. Private Sub Worksheet_Change(ByVal Target As Range)
   
2. If Application.CountA(Cells(Target.Row, 2).Resize(, 10)) <> 10 Or Target.Row < 2 Or Target.Column > 11 Then Exit Sub
   
3.    For i = 1 To Target.Row - 1
   
4.    k = 0
   
5.       For j = 2 To 11
   
6.       k = k + IIf(Application.CountIf(Cells(Target.Row, 2).Resize(, 10), Cells(i, j)) = 1, 1, 0)
   
7.       Next
   
8.       If k = 10 Then MsgBox "與第" & i & "列重複": Exit Sub
   
9.    Next
   
10. End Sub

複製代碼

---

作者: usana642    時間: 2012-6-27 17:21

回復 5# Hsieh


    謝謝超級版主的協助,謝謝您

---

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