[發問] 關於UserForm1中的ListBox應用

av8d

1. Private Sub ListBox2_Click()
   
2.     For i = 0 To ListBox1.ListCount - 1
   
3.         If ListBox2.Selected(i) = True Then
   
4.             ActiveWorkbook.Sheets(14).Select
   
5.             Cells(1, 1).Select
   
6.         End If
   
7.     Next
   
8. End Sub

複製代碼

當選擇第一個選項時，我要選擇在工作表14的A1 ，即Cells(1, 1)
當選擇第二個選項時，我要選擇在工作表14的F1 ，即Cells(1, 6)
當選擇第三個選項時，我要選擇在工作表14的K1 ，即Cells(1, 11)
當選擇第四個選項時，我要選擇在工作表14的P1 ，即Cells(1, 16)
當選擇第五個選項時，我要選擇在工作表14的A24 ，即Cells(24, 1)
當選擇第六個選項時，我要選擇在工作表14的F24 ，即Cells(24, 6)
當選擇第七個選項時，我要選擇在工作表14的K24 ，即Cells(24, 11)
當選擇第八個選項時，我要選擇在工作表14的P24 ，即Cells(24, 16)
以此類推，預計會有50個選項，每四個選項會換列，請問該如何撰寫？謝謝

目前唯一想到的方法就是寫50次

1.             If i = 0 Then Cells(1, 1).Select
   
2.             If i = 1 Then Cells(1, 6).Select
   
3.             If i = 2 Then Cells(1, 11).Select
   
4.             If i = 3 Then Cells(1, 16).Select

複製代碼

Andy2483

回復 1# av8d


    謝謝前輩發表此主題
很有意思的情境!
方便提供範例檔嗎?

singo1232001

回復 1# av8d

Andy2483

回復 3# singo1232001


   謝謝前輩
厲害了!
二元一次方程式應用上了!
後學對代數也很有興趣,有看懂,知道怎麼應用了!
謝謝前輩

(不想用方程式也可以用select case)
懇請前輩撥空設計程式碼指導後學

singo1232001

回復 4# Andy2483


'    c = 5 * L1 - 4
只有這段可改成
Select Case L1
Case 1: c = 1
Case 2: c = 6
Case 3: c = 11
Case 4: c = 16
End Select

r的部分也能改 但範圍比較大 要改很多 所以不大建議(1,24,37.......)大概要列13項以上 並且原po可能還要更多的選項 所以建議只用二元一次方程式
c的部分因為只有1,6,11,16四個選項 所以可以用select case處理

Andy2483

回復 5# singo1232001

謝謝前輩指導
後學藉這主題想搞懂  Case怎麼用
以下心得註解如有錯,請前輩指正與指導
謝謝前輩

Private Sub ListBox1_Click()
LL = ListBox1.ListIndex + 1
If LL > 0 Then
    L0 = Int((LL - 1) / 4) + 1
    r = 23 * L0 - 22
    L1 = LL - ((L0 - 1) * 4)
    '↑Case要有前因! L1 這個前因可能有多個
    Select Case L1
    '↑在 Select Case 與 End Select之間列出前因後果的種類
    Case 1: c = 1
    '↑當L1是 1 時 以:符號區隔!開始陳述結果(令c=1)
    Case 2: c = 6
    Case 3: c = 11
    Case 4: c = 16
    End Select
Unload Me
Cells(r, c).Select
End If
End Sub

lee88

回復 1# av8d
參考看看
UserForm 的程式碼

1. Dim Sh As Worksheet
   
2. Private Sub UserForm_Initialize()
   
3.     Set Sh = ActiveSheet
   
4.     ListBox1_內容制定
   
5. End Sub
   
6. Private Sub ListBox1_Click()
   
7.     With ListBox1
   
8.         If .ListIndex = -1 Then Exit Sub
   
9.        Sh.Range(.List(.ListIndex, 1)).Select
   
10.       Selection = .List(.ListIndex, 0) & "  " & .List(.ListIndex, 1)  '驗證 項目與位置
    
11.     End With
    
12. End Sub
    
13. Private Sub ListBox1_內容制定()
    
14.     Dim Ar(), R As Integer, i As Integer, ii As Integer
    
15.     Ar = Array("A", "F", "K", "P")            '指定攔位
    
16.     R = 0
    
17.     With ListBox1
    
18.         .ColumnCount = 2   ' 顯示2個欄位
    
19.         .Font.Size = 14
    
20.         For i = 0 To 49 Step 4
    
21.             R = IIf(i > 3, R + 1, 0)                 '間隔14列的計數
    
22.             For ii = 0 To 3
    
23.              If i + ii + 1 > 50 Then Exit For
    
24.                 .AddItem
    
25.                 .List(i + ii, 0) = "項" & i + ii + 1
    
26.                 .List(i + ii, 1) = Ar(ii) & IIf(R = 0, 1, R * 13 + R)   '間隔14列的位置
    
27.             Next
    
28.     Next
    
29. End With
    
30. End Sub

複製代碼

av8d

回復 3# singo1232001


感謝前輩的解答，很受用，
目前我改寫了一下，但是又卡住了，
如F1如果是空，我設定加入的項目會略過，
但指定位置就會位移，該如何改寫，謝謝。

1. Private Sub UserForm_Activate()
   
2.     Dim j As Integer
   
3.    
   
4.     For j = 1 To 300 Step 23
   
5.         If ActiveWorkbook.Sheets(1).Cells(j, 1).Value <> "" Then ListBox1.AddItem ActiveWorkbook.Sheets(1).Cells(j, 1).Value & "：" & ActiveWorkbook.Sheets(1).Cells(j + 20, 4).Value
   
6.         
   
7.         If ActiveWorkbook.Sheets(1).Cells(j, 6).Value <> "" Then ListBox1.AddItem ActiveWorkbook.Sheets(1).Cells(j, 6).Value & "：" & ActiveWorkbook.Sheets(1).Cells(j + 20, 9).Value
   
8.         
   
9.         If ActiveWorkbook.Sheets(1).Cells(j, 11).Value <> "" Then ListBox1.AddItem ActiveWorkbook.Sheets(1).Cells(j, 11).Value & "：" & ActiveWorkbook.Sheets(1).Cells(j + 20, 14).Value
   
10.                
    
11.         If ActiveWorkbook.Sheets(1).Cells(j, 16).Value <> "" Then ListBox1.AddItem ActiveWorkbook.Sheets(1).Cells(j, 16).Value & "：" & ActiveWorkbook.Sheets(1).Cells(j + 20, 19).Value
    
12.     Next
    
13. End Sub

複製代碼

singo1232001

回復 8# av8d


這牽扯到邏輯事前規劃
我的建議是 listbox 增加選項時
若為空  一樣讓它顯示文字 但不要用略過的方式處理  用空白或者"空"字取代
並且 一開始就直接讓他無法正常執行就好

Private Sub ListBox1_Click()
LL = ListBox1.ListIndex + 1
if listbox1.list(1,0)="" then exit sub
...
...
...
...
也可以最後多加個判斷 讓他忽略
if r=1,c=6 then msgbox "此項為空"  : Exit sub
Unload Me
cells(r,c).select
End sub

若去動整個主規則 那會產生更複雜的問題 而且事後會很難除錯

av8d

回復 8# av8d
回復 9# singo1232001

感謝兩位前輩，受益良多，寫法不同，目的相同，用途使用廣泛。