- 帖子
- 5923
- 主題
- 13
- 精華
- 1
- 積分
- 5986
- 點名
- 0
- 作業系統
- win10
- 軟體版本
- Office 2010
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台灣基隆
- 註冊時間
- 2010-5-1
- 最後登錄
- 2022-1-23
        
|
17#
發表於 2016-8-11 15:50
| 只看該作者
回復 16# Michelle-W
整理一下你的程式碼
可了解看看- Option Explicit
- Dim Rng As Range, Msg As Boolean
- Private Sub UserForm_Initialize()
- Msg = MsgBox("ListBox 清單的來源。" & vbLf & "Yes=使用RowSource" & vbLf & "No= 使用List(陣列)", vbYesNo) = vbYes
- ListB1
- End Sub
- Public Sub ListB1()
- Dim RO As Integer
- With Sheet2
- RO = IIf(.Cells(Rows.Count, 1).End(xlUp).Row > 2, .Cells(Rows.Count, 1).End(xlUp).Row, 2)
- Set Rng = .Range("A2:A" & RO)
- End With
- With ListBox1
- .MultiSelect = fmMultiSelectMulti
- If Msg Then
- .RowSource = Rng.Address(, , , 1, 1)
- Else
- .List = Rng.Value
- End If
- .ColumnCount = Rng.Columns.Count
- End With
- End Sub
- Private Sub 新增_Click()
- '輸入的資料回傳至儲存格記錄
- Dim RO As Integer
- With Sheet2
- RO = .[A65536].End(xlUp).Row + 1
- .Cells(RO, 1) = TextBox1.Value
- TextBox1.Value = ""
- ListB1 '重設 ListBox1
- End With
- End Sub
- Private Sub 刪除_Click()
- Dim i As Integer, r As String, E As Variant
- For i = home.ListBox1.ListCount - 1 To 0 Step -1
- If home.ListBox1.Selected(i) = True Then
- If Msg = False Then '**ListBox 清單的來源。No= 使用List(陣列)
- home.ListBox1.RemoveItem (i)
- ElseIf Msg = True Then '**ListBox 清單的來源。Yes=使用RowSource
- r = IIf(r <> "", r & "," & i + 1, i + 1)
- End If
- End If
- Next
- If Msg = True Then
- For Each E In Split(r, ",")
- Rng.Rows(E).Delete '**刪除範圍中的資料 Yes=使用RowSource
- Next
- ListB1
- End If
- End Sub
- Private Sub 匯入_Click()
- Dim AA, xi As Integer
- With ListBox1
- For xi = 0 To .ListCount - 1
- ' 判斷列表框 (ListBox1) 是否有被點選
- If .Selected(xi) = True Then
- ' 取出該行之數據,存入 AA 陣列中
- AA = Application.Index(ListBox1.List, xi + 1)
- 'With Sheets("sheet3").Range("A" & Rows.Count).Offset(1) '.Offset(1) '**還是下一儲存格
- With Sheets("sheet3").Range("A" & Rows.Count).End(xlUp).Offset(1) '.Offset(1) '**還是下一儲存格
- .Cells = .Cells + AA
- '還是 .Cells = .Cells + AA '資料是累積的
- End With
- End If
- Next
- End With
- End Sub
複製代碼 |
|