四级有效性

liulang0808 · 发表于 2020-12-18 20:03

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.CountLarge <> 1 Then Exit Sub
If Target.Row < 4 Then Exit Sub
Set d = CreateObject("scripting.dictionary")
If Target.Column = 2 Then
      arr = Sheets("资料库").UsedRange
      For j = 3 To UBound(arr)
         d(arr(j, 2)) = ""
      Next j
      Call youxiao(Target, Join(d.keys, ","))
Else
      If Target.Column = 3 Then
         If Len(Target.Offset(0, -1)) > 0 Then
            arr = Sheets("资料库").UsedRange
            For j = 3 To UBound(arr)
                  If arr(j, 2) = Target.Offset(0, -1) Then d(arr(j, 3)) = ""
            Next j
            Call youxiao(Target, Join(d.keys, ","))
         End If
      Else
         If Target.Column = 4 Then
            str1 = ""
            If Len(Target.Offset(0, -1)) > 0 Then
                  str1 = Target.Offset(0, -1)
            Else
                  For i = Target.Row To 4 Step -1
                     If Len(Cells(i, 3)) > 0 Then
                        str1 = Cells(i, 3)
                        Exit For
                     End If
                  Next i
            End If
            If Len(str1) > 0 Then
                  arr = Sheets("出入库").UsedRange
                  For j = 3 To UBound(arr)
                     If arr(j, 24) = str1 Then d(arr(j, 25)) = ""
                  Next j
                  Call youxiao(Target, Join(d.keys, ","))
            End If
         Else
            If Target.Column = 5 Then
                  If Len(Target.Offset(0, -1)) > 0 Then
                     arr = Sheets("出入库").UsedRange
                     For j = 3 To UBound(arr)
                        If arr(j, 25) = Target.Offset(0, -1) Then d(arr(j, 26)) = ""
                     Next j
                     Call youxiao(Target, Join(d.keys, ","))
                  End If
            End If
         End If

      End If
End If
End Sub

Sub youxiao(rng, k)
If Len(k) > 0 Then
With rng.Validation
      .Delete
      .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
      xlBetween, Formula1:=k
      .IgnoreBlank = True
      .InCellDropdown = True
      .InputTitle = ""
      .ErrorTitle = ""
      .InputMessage = ""
      .ErrorMessage = ""
      .IMEMode = xlIMEModeNoControl
      .ShowInput = True
      .ShowError = True
End With
End If
End Sub

liulang0808 · 发表于 2020-12-18 20:03

附件内容供参考。。。。。。

①然如故 · 发表于 2020-12-18 21:41

本帖最后由 ①然如故于 2020-12-18 21:45 编辑

liulang0808 发表于 2020-12-18 20:03
附件内容供参考。。。。。。

liulang0808老师您好，非常感谢您的帮助，就是要这样的效果非常完美，还有一点都怪我没描述清楚，"资料库"B 列只要引用（提取） "动态客户" ， "事业单位" ， "总包商" ， " *公司" ，（注：公司是不顾定名称，只要包含公司两个字），附件我已更新，请您再帮修正，

变更四级联动格式.rar (59.21 KB, 下载次数: 20)

①然如故 · 发表于 2020-12-18 22:11

本帖最后由 ①然如故于 2020-12-18 22:14 编辑

liulang0808 发表于 2020-12-18 20:03
附件内容供参考。。。。。。

liulang0808老师您好，刚才运行发现个小问题，如图
纠正下，明细表C列=资料库C列&出入库X列。

①然如故 · 发表于 2020-12-19 00:26

liulang0808 发表于 2020-12-18 20:03
附件内容供参考。。。。。。

liulang0808老师您好，13楼的问题已解决，我在程序中加了句判断
If arr(j, 2) = "?动态客户" Or arr(j, 2) = "事业单位" Or arr(j, 2) = "总包商" Or Right(arr(j, 2), 2) = "公司" Then
可以实现结果，14楼的问题我摸索了很久都未能解决，希望能得到您的帮助，在下感激不尽。

liulang0808 · 发表于 2020-12-19 16:08

①然如故发表于 2020-12-19 00:26
liulang0808老师您好，13楼的问题已解决，我在程序中加了句判断
If arr(j, 2) = "?动态客户" Or arr(j, ...

楼主的问题看不明白，就是级联的内容的关联关系是怎么对应的？

①然如故 · 发表于 2020-12-19 17:29

liulang0808 发表于 2020-12-19 16:08
楼主的问题看不明白，就是级联的内容的关联关系是怎么对应的？

liulang0808老师您好，就是出入库X43只对应Y43，Z43

①然如故 · 发表于 2020-12-19 19:02

liulang0808 发表于 2020-12-19 16:08
楼主的问题看不明白，就是级联的内容的关联关系是怎么对应的？

liulang0808老师您好，我在17的描述不知您能理解，如果清楚请您再帮更正下，谢谢！

liulang0808 · 发表于 2020-12-19 21:12

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.CountLarge <> 1 Then Exit Sub
If Target.Row < 4 Then Exit Sub
Set d = CreateObject("scripting.dictionary")
If Target.Column = 2 Then
      arr = Sheets("资料库").UsedRange
      For j = 3 To UBound(arr)
         d(arr(j, 2)) = ""
      Next j
      Call youxiao(Target, Join(d.keys, ","))
Else
      If Target.Column = 3 Then
         If Len(Target.Offset(0, -1)) > 0 Then
            arr = Sheets("资料库").UsedRange
            For j = 3 To UBound(arr)
                  If arr(j, 2) = Target.Offset(0, -1) Then d(arr(j, 3)) = ""
            Next j
            Call youxiao(Target, Join(d.keys, ","))
         End If
      Else
         If Target.Column = 4 Then
            str1 = ""
            If Len(Target.Offset(0, -1)) > 0 Then
                  str1 = Target.Offset(0, -1)
            Else
                  For i = Target.Row To 4 Step -1
                     If Len(Cells(i, 3)) > 0 Then
                        str1 = Cells(i, 3)
                        Exit For
                     End If
                  Next i
            End If
            If Len(str1) > 0 Then
                  arr = Sheets("出入库").UsedRange
                  For j = 3 To UBound(arr)
                     If arr(j, 24) = str1 Then d(arr(j, 25)) = ""
                  Next j
                  Call youxiao(Target, Join(d.keys, ","))
            End If
         Else
            If Target.Column = 5 Then
                  If Len(Target.Offset(0, -1)) > 0 Then
                     For i = Target.Row To 4 Step -1
                        If Len(Cells(i, 3)) > 0 Then
                              str1 = Cells(i, 3)
                              Exit For
                        End If
                     Next i
                     arr = Sheets("出入库").UsedRange
                     For j = 3 To UBound(arr)
                        If arr(j, 25) = Target.Offset(0, -1) And arr(j, 24) = str1 Then d(arr(j, 26)) = ""
                     Next j
                     Call youxiao(Target, Join(d.keys, ","))
                  End If
            End If
         End If

      End If
End If
End Sub

Sub youxiao(rng, k)
If Len(k) > 0 Then
With rng.Validation
      .Delete
      .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
      xlBetween, Formula1:=k
      .IgnoreBlank = True
      .InCellDropdown = True
      .InputTitle = ""
      .ErrorTitle = ""
      .InputMessage = ""
      .ErrorMessage = ""
      .IMEMode = xlIMEModeNoControl
      .ShowInput = True
      .ShowError = True
End With
End If
End Sub

liulang0808 · 发表于 2020-12-19 21:12

附件内容供参考。。。。。。

		自动登录	找回密码
密码			免费注册

[已解决] 四级有效性

评分

评分

评分

评分

评分