VBA 抓取ListBox中的內容

wang077

中學生 Rank: 2

帖子: 104
主題: 10
精華: 0
積分: 114
點名: 0
作業系統: Windows 10
軟體版本: Office 2007
閱讀權限: 20
性別: 男
註冊時間: 2021-6-21
最後登錄: 2021-8-24

21^# 跳轉到 »

發表於 2021-7-6 09:13 | 顯示全部帖子

回復 36# samwang
測試過了，沒問題
非常感謝大大，一直麻煩你，辛苦了

TOP

wang077

中學生 Rank: 2

帖子: 104
主題: 10
精華: 0
積分: 114
點名: 0
作業系統: Windows 10
軟體版本: Office 2007
閱讀權限: 20
性別: 男
註冊時間: 2021-6-21
最後登錄: 2021-8-24

22^#

發表於 2021-7-6 17:08 | 顯示全部帖子

回復 36# samwang
大大，抱歉，我又有麻煩了
如果開啟表單後要直接把機1，機2叫出來在ListBox上呢，等於不要有選擇資料夾這步驟

TOP

wang077

中學生 Rank: 2

帖子: 104
主題: 10
精華: 0
積分: 114
點名: 0
作業系統: Windows 10
軟體版本: Office 2007
閱讀權限: 20
性別: 男
註冊時間: 2021-6-21
最後登錄: 2021-8-24

23^#

發表於 2021-7-6 19:24 | 顯示全部帖子

回復 40# samwang
那如果直接把機1、機2那個資料夾當預設的資料夾呢？

TOP

wang077

中學生 Rank: 2

帖子: 104
主題: 10
精華: 0
積分: 114
點名: 0
作業系統: Windows 10
軟體版本: Office 2007
閱讀權限: 20
性別: 男
註冊時間: 2021-6-21
最後登錄: 2021-8-24

24^#

發表於 2021-7-7 07:56 | 顯示全部帖子

回復 42# samwang
因為機1，機2是我抓出來當範例用，之後如果完成還會加入更多
那如果資料夾的路徑是固定的，檔案也都固定放在資料夾裏的話呢?

TOP

wang077

中學生 Rank: 2

帖子: 104
主題: 10
精華: 0
積分: 114
點名: 0
作業系統: Windows 10
軟體版本: Office 2007
閱讀權限: 20
性別: 男
註冊時間: 2021-6-21
最後登錄: 2021-8-24

25^#

發表於 2021-7-7 09:03 | 顯示全部帖子

回復 44# samwang
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.AskToUpdateLinks = False
fileorg = ActiveWorkbook.Name
Set xD = CreateObject("Scripting.Dictionary")
For i1 = 1 To n1
If Not xD.Exists(Ar(i1, 1) & "") Then
      xD(Ar(i1, 1) & "") = ""
      For i = 1 To n
         If Arr(i, 2) = Ar(i1, 1) Then n2 = n2 + 1: Ar1(n2, 1) = Arr(i, 1)
      Next
End If
Next
R = 1: Sheets("6月份數據").Select
With Sheets("6月份數據")
If .FilterMode Then .ShowAllData
.Range("a1:AA" & .[a65536].End(3).Row).Delete
Tm = Timer
For i1 = 1 To n2
      Set WB = Workbooks.Open(Ar1(i1, 1))
      With Sheets("6月份數據")
         If .FilterMode Then .ShowAllData
         fn = Split(ActiveWorkbook.Name, ".")(0)
         .Range("a1:z" & .[a65536].End(3).Row).Copy Workbooks(fileorg).Sheets("6月份數據").Range("a" & R)
      End With
      WB.Close
      .Range("U" & R & ":U" & .[a65536].End(xlUp).Row) = fn
      R = .[a65536].End(xlUp).Row + 1
Next
End With
MsgBox "資料複製完成" & Timer - Tm & "秒"
Erase Arr: Erase Ar
Unload Me

Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.AskToUpdateLinks = True

複製資料的時候
Set WB = Workbooks.Open(Ar1(i1, 1))
這行出現了錯誤

TOP

wang077

中學生 Rank: 2

帖子: 104
主題: 10
精華: 0
積分: 114
點名: 0
作業系統: Windows 10
軟體版本: Office 2007
閱讀權限: 20
性別: 男
註冊時間: 2021-6-21
最後登錄: 2021-8-24

26^#

發表於 2021-7-7 09:10 | 顯示全部帖子

回復 45# wang077
找到錯誤了，剛剛把程式檔放再同一個資料夾，所以出現錯誤
以解決這錯誤

TOP

wang077

中學生 Rank: 2

帖子: 104
主題: 10
精華: 0
積分: 114
點名: 0
作業系統: Windows 10
軟體版本: Office 2007
閱讀權限: 20
性別: 男
註冊時間: 2021-6-21
最後登錄: 2021-8-24

27^#

發表於 2021-7-7 10:39 | 顯示全部帖子

本帖最後由 wang077 於 2021-7-7 10:40 編輯

回復 44# samwang
Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.AskToUpdateLinks = False
fileorg = ActiveWorkbook.Name
Set xD = CreateObject("Scripting.Dictionary")
For i1 = 1 To n1
If Not xD.Exists(Ar(i1, 1) & "") Then
      xD(Ar(i1, 1) & "") = ""
      For i = 1 To n
         If Arr(i, 2) = Ar(i1, 1) Then n2 = n2 + 1: Ar1(n2, 1) = Arr(i, 1)
      Next
End If
Next
R = 1: Sheets("6月份數據").Select
With Sheets("6月份數據")
If .FilterMode Then .ShowAllData
.Range("a1:AA" & .[a65536].End(3).Row).Delete
Tm = Timer
For i1 = 1 To n2
      Set WB = Workbooks.Open(Ar1(i1, 1))
      With Sheets("6月份數據")
         If .FilterMode Then .ShowAllData
         fn = Split(ActiveWorkbook.Name, ".")(0)
         .Range("a1:z" & .[a65536].End(3).Row).Copy Workbooks(fileorg).Sheets("6月份數據").Range("a" & R)
      End With
      WB.Close
      .Range("U" & R & ":U" & .[a65536].End(xlUp).Row) = fn
      R = .[a65536].End(xlUp).Row + 1
Next
End With
MsgBox "資料複製完成" & Timer - Tm & "秒"
Erase Arr: Erase Ar

Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.AskToUpdateLinks = True
End Sub

大大，我把複製資料的程式碼丟進去ListBox1_DblClick裡面
可以直接選取ListBox來叫出資料，但我如果第一次點擊機1可以叫出機1的資料，我第二次點擊機2的時候
他又顯示這錯誤了
求解！