[已解决]用VBA判断三个条件只要满足其中一个则跳出

lidayu

grf1973 发表于 2016-2-14 13:48
循环里面这样写
For i = 1 To UBound(ARR)
            For j = 2 To 4

grf1973您好 ，新建姓名DD，项目1-3为空还是出现重复保存

上清宫主

lidayu 发表于 2016-2-14 16:06
上清宫主您好 ，您的思路很正确谢谢您的赐教，不同姓名可以重复项目。请您帮我写下代码，谢谢！

你这一回复，晕了：不同姓名的情况下项目可以重复，那么是不是说姓名没重的时候，项目随便填都可以，不必管他； 当姓名重复的时候，再看相关的姓名其项目是否有相同的，不同则直接填进到，相同了则提示重复。
是不是这样？

grf1973

那是你的数组没定义对，改成
ARR = Sheets("资料库").Range("a3:d" & Sheets("资料库").[a999].End(3).Row)
记录数由A列确定，而不是D列。

lidayu

上清宫主 发表于 2016-2-14 16:20
你这一回复，晕了：不同姓名的情况下项目可以重复，那么是不是说姓名没重的时候，项目随便填都可以，不必 ...

上清宫主您好 是这样的，
例１：姓名A3=张三，项目B3=百姓，C3=“”、D3=万家，
　　　姓名A4=李四，项目B4=百姓，C4=“”、D4=万家，视为不重复。
例２：窗体新建内容时姓名张三，项目１＝大润发，项目２＝“ ”，项目３＝“ ”视为不重复。　
我是这样想的，
例２的要求可能还要先判断，在表中姓名为张三的项目中的“大润发”是否存在，如不存在则保存，但这个也出现一个张三的项目已有空了。
所以要先判断新建内容如表中没有则保存，同时出现重复及新内容时新内容优先（保存）。

lidayu

grf1973 发表于 2016-2-14 16:27
那是你的数组没定义对，改成
ARR = Sheets("资料库").Range("a3:d" & Sheets("资料库").[a999].End(3).Row ...

您好，代码是这样的请查看

1. Private Sub CommandButton1_Click()
   
2.     Dim a As Integer
   
3.     Dim i As Long
   
4.     Dim myControl As Control
   
5.      Set d = CreateObject("Scripting.Dictionary")
   
6.        ARR = Sheets("资料库").Range("a3:d" & Sheets("资料库").[d999].End(3).Row)
   
7. For i = 1 To UBound(ARR)
   
8.              For j = 2 To 4
   
9.                 d(ARR(i, 1) & ARR(i, j)) = i
   
10.                 d(ARR(i, 1)) = i
    
11.              Next
    
12.          Next
    
13.       If d.exists(姓名.Value & 项目1.Value) Then CreateObject("WScript.Shell").Popup "该客户已存在!", 1, "提示": Unload Me: Exit Sub
    
14.       If d.exists(姓名.Value & 项目2.Value) Then CreateObject("WScript.Shell").Popup "该客户已存在!", 1, "提示": Unload Me: Exit Sub
    
15.       If d.exists(姓名.Value & 项目3.Value) Then CreateObject("WScript.Shell").Popup "该客户已存在!", 1, "提示": Unload Me: Exit Sub
    
16.   a = Sheets("资料库").[a65536].End(xlUp).Row
    
17.     With Sheets("资料库").Range("A" & a + 1)
    
18.         .Offset(0, 0).Value = 姓名.Value
    
19.         .Offset(0, 1).Value = 项目1.Value
    
20.         .Offset(0, 2).Value = 项目2.Value
    
21.         .Offset(0, 3).Value = 项目3.Value
    
22.         .Offset(0, 4).Value = 电话.Value
    
23.         .Offset(0, 5).Value = 开 户 银 行.Value
    
24.         .Offset(0, 6).Value = 银 行 帐 号.Value
    
25.     End With
    
26.     If 类别.Text = "" Or 名称.Text = "" Then
    
27.     Else
    
28.     With Sheets("明细表")
    
29.         i = .[a1].CurrentRegion.Rows.Count + 1
    
30.         .Cells(i, 1) = DTPicker1.Value
    
31.         .Cells(i, 2) = 类别.Text
    
32.         .Cells(i, 3) = 名称.Text
    
33.         .Cells(i, 4) = 项目.Text
    
34.         .Cells(i, 5) = 摘要.Text
    
35.         .Cells(i, 6) = 凭证.Text
    
36.         .Cells(i, 7) = 银 行 卡 号.Text
    
37.         .Cells(i, 8) = 收入.Text
    
38.         .Cells(i, 9) = 支出.Text
    
39.         .Cells(i, 10) = 借或贷.Text
    
40.         .Cells(i, 11) = 备注.Text
    
41.     End With
    
42.     End If
    
43.     CreateObject("WScript.Shell").Popup "您已保存成功!", 1, "提示"
    
44.       Unload Me '卸载 我（窗体）
    
45. End Sub
    

复制代码

grf1973

是不是这个意思：
1、姓名+任一项目（非空）重复则重复
2、如果资料库中有只有姓名，没有项目的情况，那么如果输入姓名+项目（全空），视为重复。

grf1973

输入姓名cc，项目cc3，算不算重复？

grf1973

[code]Private Sub CommandButton1_Click()
    Dim a As Integer
    Dim i As Long
    Dim myControl As Control
     Set d = CreateObject("Scripting.Dictionary")
       ARR = Sheets("资料库").Range("a3:d" & Sheets("资料库").[a999].End(3).Row)
        For i = 1 To UBound(ARR)
            d(ARR(i, 1)) = i
            For j = 2 To 4
                If Len(ARR(i, j)) > 0 Then d(ARR(i, 1) & ARR(i, j)) = i
            Next
        Next
     If 项目1.Value <> "" And d.exists(姓名.Value & 项目1.Value) Then CreateObject("WScript.Shell").Popup "该客户已存在!", 1, "提示": Unload Me: Exit Sub
     If 项目2.Value <> "" And d.exists(姓名.Value & 项目2.Value) Then CreateObject("WScript.Shell").Popup "该客户已存在!", 1, "提示": Unload Me: Exit Sub
     If 项目3.Value <> "" And d.exists(姓名.Value & 项目3.Value) Then CreateObject("WScript.Shell").Popup "该客户已存在!", 1, "提示": Unload Me: Exit Sub
     If 项目1.Value & 项目2.Value & 项目3.Value = "" And d.exists(姓名.Value) Then CreateObject("WScript.Shell").Popup "该客户已存在!", 1, "提示": Unload Me: Exit Sub
  。。。。。。。。

grf1973

。。。。。。。。。。。

lidayu

grf1973 发表于 2016-2-14 16:57
。。。。。。。。。。。

grf1973 您好，就是要这样结果，可能我的表达有误，造成了很多老师的误解导致一直未能达到想要效果，还是您完美的实现了，您真棒{:1112:}，谢谢您！