Board logo

標題: 請問儲存格自訂表單功能 [打印本頁]
作者: tonycho33    時間: 2012-2-1 14:31     標題: 請問儲存格自訂表單功能

請問我想在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    時間: 2012-2-1 16:27

回復 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    時間: 2012-2-1 17:56

回復 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    時間: 2012-2-1 23:52

回復 3# tonycho33

是否如附件效果
[attach]9369[/attach]
作者: tonycho33    時間: 2012-2-2 11:38

回復 4# Hsieh


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

另外，可以不要指定到B12嗎？
用Columns("B")可以嗎
但是這樣會搜尋到空格，導致在SHEET1點選到空格也會彈出
要如何設定呢
謝謝
作者: Hsieh    時間: 2012-2-2 13:47

回復 5# tonycho33

如葛是搜尋2欄的資料
那就再增加判斷在哪一欄搜尋到
才能正確指出C欄以後的資料
作者: tonycho33    時間: 2012-2-3 07:55

本帖最後由 tonycho33 於 2012-2-3 09:11 編輯

回復 6# Hsieh


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

回復 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    時間: 2012-2-3 09:53

本帖最後由 tonycho33 於 2012-2-3 10:16 編輯

回復 8# Hsieh

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


謝謝
作者: tonycho33    時間: 2012-2-8 08:31

回復 8# Hsieh


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



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