[已解决]【求助】根据单元格的值出自动选择项

xdwy81129

请求老师帮助：

H列的值为填列的是A列的数据
求教的是，在H5-H10之间有数据时，有下列箭头选择C列的蓝色的数据
注意：红色底是A列的数据,蓝色才是真正的c列数据只是
更注意的是：A列，B列有数据增加，如果非要不考虑数据有增加的情况，请老师指明在数据增加时怎么改变。

Hesijvr1.rar (2.78 KB, 下载次数: 5)

2009-12-15 08:58 上传

点击文件名下载附件
【求助】根据单元格的值出自动选择项

最佳答案

月排行榜 / 总排行榜

1970-1-1 08:00

跳转到最佳答案楼层

xdwy81129

顶下，盼解答

xdwy81129

QUOTE:

以下是引用xdwy81129在2009-12-16 7:04:00的发言：

顶下，盼解答

期待中

amulee

在这个Sheet里面加上如下代码：

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Count = 1 Then
        If Target.Column = 10 And (Target.Row > 4 And Target.Row < 11) Then
            Dim strYS$, YS1$, YS2$, ArrYS2, i&, strAdd1$, strAdd2$, lngTemp&
            strYS = Cells(Target.Row, 8)
            If Len(strYS) > 0 Then
                YS1 = Join(Application.Transpose(Range("A2:A" & Range("A65536").End(xlUp).Row)), ",")
                ArrYS2 = Application.Transpose(Range("C2:C" & Range("A65536").End(xlUp).Row))
                YS2 = Join(ArrYS2, ",")
                If InStr(1, YS1, strYS, vbTextCompare) > 0 And InStr(1, YS2, strYS, vbTextCompare) Then
                    lngTemp = WorksheetFunction.Match(strYS, ArrYS2, 0)
                    strAdd1 = "$C$" & lngTemp + 2
                    For i = lngTemp + 1 To UBound(ArrYS2)
                        If InStr(1, YS1, ArrYS2(i), vbTextCompare) > 0 Then
                            strAdd2 = "$C$" & i
                            Exit For
                        End If
                    Next i
                    With Selection.Validation
                        .Delete
                        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
                            xlBetween, Formula1:="=" & strAdd1 & ":" & strAdd2
                    End With
                End If
            End If
        End If
    End If
End Sub

开辆小富康

DY3477hY.rar (10.82 KB, 下载次数: 2)

2009-12-16 13:55 上传

点击文件名下载附件
【求助】根据单元格的值出自动选择项
根据D列的数字代码取值。要求，如“老师”项下，要连续排该项下面的选项，不能和其他选项混乱排。

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Tar, Tarnum, C As Range

On Error Resume Next
 If Target.Count = 1 And Not Intersect(Target, Range("H5:H10")) Is Nothing Then
    Tar = Target.Value
    For Each C In Range("c1", Range("c65536").End(xlUp))
     If C.Value = Tar Then Exit For
    Next C
    If C = Range("c65536").End(xlUp) And C <> Tar Then Exit Sub
    Tarnum = C.Offset(0, 1)
    Do
     i = i + 1
     If Left(C.Offset(i, 1), Len(Tarnum)) <> "" & Tarnum Then Exit Do
    Loop
 
   
    With Target.Offset(0, 2).Validation
     .Delete
     .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
          xlBetween, Formula1:="=$C$" & C.Row + 1 & ":$C$" & C.Row + i - 1
    End With
 End If
End Sub

[此贴子已经被作者于2009-12-16 13:57:55编辑过]

xdwy81129

感谢2位老师，可惜都缺少H列不是正确的或者空白的值时，J列的下拉选择仍然有。

 

阿木老师的要好些 ，H列不是正确的或者空白的值时，J列的下拉选择为上次的。

 

富康老师的J列则的下拉菜单仍然变动。

 

希望能看到完美的答案。

 

曾经看见过有老师做到的3级（3个下拉），第二个更具第一个的选择出来，第三个根据第二个下拉的值选择出来，很厉害的东西。（应该是vb做的）

 

 

[em01][em01][em01]

开辆小富康

RHlNTCz1.rar (11.05 KB, 下载次数: 2)

2009-12-16 21:00 上传

点击文件名下载附件
【求助】根据单元格的值出自动选择项

xdwy81129

QUOTE:

以下是引用开辆小富康在2009-12-16 21:00:00的发言：

zsd5237

学习[em02][em02]

amulee

QUOTE:

以下是引用xdwy81129在2009-12-16 18:08:00的发言：

感谢2位老师，可惜都缺少H列不是正确的或者空白的值时，J列的下拉选择仍然有。

 

阿木老师的要好些 ，H列不是正确的或者空白的值时，J列的下拉选择为上次的。

 

富康老师的J列则的下拉菜单仍然变动。

 

希望能看到完美的答案。

 

曾经看见过有老师做到的3级（3个下拉），第二个更具第一个的选择出来，第三个根据第二个下拉的值选择出来，很厉害的东西。（应该是vb做的）

 

 

[em01][em01][em01]

不正确或者空白的时候下拉里面显示啥东东呢