返回列表 上一主題 發帖

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

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

本帖最後由 av8d 於 2022-10-17 13:07 編輯
  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
複製代碼

回復 1# av8d


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

TOP

本帖最後由 singo1232001 於 2022-10-17 17:01 編輯

回復 1# av8d

listbox選項v2.zip (23.7 KB)

TOP

回復 3# singo1232001


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

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

TOP

回復 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處理

TOP

回復 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

TOP

回復 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
複製代碼

TOP

回復 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
複製代碼

TOP

本帖最後由 singo1232001 於 2022-10-20 13:01 編輯

回復 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

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

listbox選項v3.zip (24.74 KB)

TOP

回復 8# av8d
回復 9# singo1232001

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

TOP

        靜思自在 : 原諒別人就是善待自己。
返回列表 上一主題