目前仍無法修改成功....再麻煩各位大大協助解惑！謝謝～
原本程式如下：
Private Sub UserForm_Activate()
Set h = Sheets("Cleaner")
For g = 2 To 50
If h.Cells(g, 2) "" Then
Cleaner1.AddItem h.Cells(g, 2)
Cleaner2.AddItem h.Cells(g, 2)
Cleaner3.AddItem h.Cells(g, 2)
Cleaner4.AddItem h.Cells(g, 2)
Cleaner5.AddItem h.Cells(g, 2)
Cleaner6.AddItem h.Cells(g, 2)
Cleaner7.AddItem h.Cells(g, 2)
Cleaner8.AddItem h.Cells(g, 2)
Cleaner9.AddItem h.Cells(g, 2)
Cleaner10.AddItem h.Cells(g, 2)
Cleaner11.AddItem h.Cells(g, 2)
Cleaner12.AddItem h.Cells(g, 2)
Cleaner13.AddItem h.Cells(g, 2)
Cleaner14.AddItem h.Cells(g, 2)
Cleaner15.AddItem h.Cells(g, 2)
Cleaner16.AddItem h.Cells(g, 2)
Cleaner17.AddItem h.Cells(g, 2)
Cleaner18.AddItem h.Cells(g, 2)
Cleaner19.AddItem h.Cells(g, 2)
Cleaner20.AddItem h.Cells(g, 2)
Cleaner21.AddItem h.Cells(g, 2)
Cleaner22.AddItem h.Cells(g, 2)
End If
Next g
Set p = Sheets("Work")
For q = 2 To 50
If p.Cells(q, 2) "" Then
Work1.AddItem p.Cells(q, 2)
Work2.AddItem p.Cells(q, 2)
Work3.AddItem p.Cells(q, 2)
Work4.AddItem p.Cells(q, 2)
Work5.AddItem p.Cells(q, 2)
Work6.AddItem p.Cells(q, 2)
Work7.AddItem p.Cells(q, 2)
Work8.AddItem p.Cells(q, 2)
Work9.AddItem p.Cells(q, 2)
Work10.AddItem p.Cells(q, 2)
Work11.AddItem p.Cells(q, 2)
Work12.AddItem p.Cells(q, 2)
Work13.AddItem p.Cells(q, 2)
Work14.AddItem p.Cells(q, 2)
Work15.AddItem p.Cells(q, 2)
Work16.AddItem p.Cells(q, 2)
Work17.AddItem p.Cells(q, 2)
Work18.AddItem p.Cells(q, 2)
Work19.AddItem p.Cells(q, 2)
Work20.AddItem p.Cells(q, 2)
Work21.AddItem p.Cells(q, 2)
Work22.AddItem p.Cells(q, 2)
End If
Next q
End Sub
