請問儲存格自訂表單功能

tonycho33

請問我想在B2～E2、B5～E5、B10～D10的儲存格中
只要點到對應儲存格，則可彈出UserForm1
然後A、B、C、D、E則能對應到sheet2上的資料帶入空格中

另外分別設定按鈕設定B2～E2、B5～E5、B10～D10的儲存格
對應的C、D、E（連結到sheet2）如果與設定的L13、L14、L15
則B2～E2、B5～E5、B10～D10的儲存格會出現紅底白字

GBKEE

回復 1# tonycho33
請問我想在B2～E2、B5～E5、B10～D10的儲存格中只要點到對應儲存格，則可彈出UserForm1

1. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   
2.     If Not Intersect(Range("B2:E2,B5:E5,B10:E10"), Target) Is Nothing Then UserForm1.Show
   
3. End Sub

複製代碼

[ 然後A、B、C、D、E則能對應到sheet2上的資料帶入空格中另外分別設定按鈕設定B2～E2、B5～E5、B10～D10的儲存格
對應的C、D、E（連結到sheet2）如果與設定的L13、L14、L15 則B2～E2、B5～E5、B10～D10的儲存格會出現紅底白字]
請再說清楚些

tonycho33

回復 2# GBKEE


    例如點B2儲存格（ggg）
則彈出userform
然後
A/B/C/D/E 下方 空格帶出
B4/A2/5/13/5

然後按C按鈕檢視所有第三欄是否有小於5（L13儲存格的值），如果是，就該儲存格反紅
按D按鈕檢視所有第三欄是否有小於5（L14儲存格的值），如果是，就該儲存格反紅
按E按鈕檢視所有第三欄是否有小於8（L15儲存格的值），如果是，就該儲存格反紅

Hsieh

回復 3# tonycho33

是否如附件效果
儲存格自訂表單.rar (19.18 KB)

下載次數: 24

2012-2-1 23:52

tonycho33

回復 4# Hsieh


     你好
測試OK
有個問題想請教
程式中的一行   
Set a = Sheet2.[B2:B12].Find(Target, lookat:=xlWhole)
從sheet2 的B2：B12欄位搜尋
如果想新增 sheet2的A欄也可以搜尋要如何修改
就是A欄或是B欄都可以

另外，可以不要指定到B12嗎？
用Columns("B")可以嗎
但是這樣會搜尋到空格，導致在SHEET1點選到空格也會彈出
要如何設定呢
謝謝

Hsieh

回復 5# tonycho33

如葛是搜尋2欄的資料
那就再增加判斷在哪一欄搜尋到
才能正確指出C欄以後的資料

tonycho33

回復 6# Hsieh


我想增加A欄或B欄其中一個搜尋的到的話就可以顯示
另外，Set a = Sheet31.[F4:F29].Find(Target, lookat:=xlWhole)
當中的[F4:F29]，可以改為列出有文字內容儲存格的範圍就好嗎
例如，這次是到F29儲存格有內容，但如果貼上更新資料後,可能會到F32等，範圍值會更新，每次都不一樣
謝謝

Hsieh

回復 7# tonycho33

Sheet1模組

1. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   
2. Set Rng = Range("B2:E2,B5:E5,B10:E10")
   
3. Rng.Interior.ColorIndex = xlNone
   
4. Rng.Font.ColorIndex = xlAutomatic
   
5.     If Not Intersect(Rng, Target) Is Nothing Then
   
6.     Set a = Sheet2.[A:B].Find(Target, lookat:=xlWhole)
   
7.     If Not a Is Nothing Then
   
8.    k = 3 - a.Column
   
9.     Ar = a.Offset(, k).Resize(, 5).Value
   
10.         With UserForm1
    
11.     .Show 0
    
12.     '因為TEXTBOX並未依序排列所以必須一一給值
    
13.     .TextBox27 = Ar(1, 4)
    
14.     .TextBox28 = Ar(1, 5)
    
15.     .TextBox29 = Ar(1, 3)
    
16.     .TextBox30 = Ar(1, 2)
    
17.     .TextBox31 = Ar(1, 1)
    
18.     End With
    
19.     End If
    
20.     End If
    
21. End Sub

複製代碼

一般模組

1. Sub Ex()
   
2. Dim Ob As Shape, Ar(), Rng As Range
   
3. Set Ob = Sheet1.Shapes(Application.Caller)
   
4. Set Rng = Sheet1.Range("B2:E2,B5:E5,B10:E10")
   
5. Rng.Interior.ColorIndex = xlNone
   
6. Rng.Font.ColorIndex = xlAutomatic
   
7. a = Asc(Ob.TextFrame.Characters.Text) + 2
   
8. b = Sheet1.Cells(Ob.TopLeftCell.Row, "L").Value
   
9. With Sheet2
   
10. For Each c In .Range(Chr(a) & 1).EntireColumn.SpecialCells(xlCellTypeConstants)
    
11. If c < b Then
    
12. For i = 1 To 2
    
13. If .Cells(c.Row, i) <> "" Then
    
14. ReDim Preserve Ar(s)
    
15. Ar(s) = .Cells(c.Row, i)
    
16. s = s + 1
    
17. End If
    
18. Next
    
19. End If
    
20. Next
    
21. End With
    
22. If s > 0 Then
    
23. For Each d In Ar
    
24.   With Rng.Find(d, lookat:=xlWhole)
    
25.   .Interior.ColorIndex = 3
    
26.   .Font.ColorIndex = 2
    
27.   End With
    
28. Next
    
29. End If
    
30. End Sub

複製代碼

tonycho33

回復 8# Hsieh

請問
1.   
Set Rng = Range("B2:E2,B5:E5,B10:E10")如果要改成
Set Rng = Range("B2::E10")
點選範圍內空格時，可以讓他不要彈出視窗嗎
2.sheet2的A及B欄如果是帶公式進來的會無法在sheet1上顯示
要如何改呢


謝謝

tonycho33

回復 8# Hsieh


    請問
TextBox27～TextBox31
裡面的數字可以變顏色嗎
例如：小餘5就反紅
謝謝