麻辣家族討論版版 - Powered by Discuz! Board

標題: [發問] 將開啟後檔案的指定內容依序複製貼上。 [打印本頁]

作者: ziv976688 時間: 2021-8-21 14:44 標題: 將開啟後檔案的指定內容依序複製貼上。

本帖最後由 ziv976688 於 2021-8-21 15:04 編輯

[attach]33932[/attach]
備註：
7C機資料夾內共有1~98個檔案(本題以5個檔案為例)。

需求：
請將7C機資料夾內的自動開啟檔案，以名稱的第4段數字為基準(EX：7C機_1878期_100_1877-10_1次)~
由大而小~將各已開啟的檔案內之"機率表!"A&B二欄的內容複製後，依序貼上主檔之"Sheet1!"的M1。

請詳見7C_0_1878期_5個(效果檔)。

以上的需求語法
懇請各位大大幫忙和指教 ! 謝謝 !

作者: ziv976688 時間: 2021-8-23 08:17

本帖最後由 ziv976688 於 2021-8-23 08:18 編輯

我的困難點是在無法依第4段數字選擇"由大而小"的順序~
因為無論將"7C機"資料夾內的檔案名稱遞增或遞減排序，
檔案開啟的順序都是"由小而大"，
所以不知道如何起始編寫程式碼 ?

懇請各位大大幫忙和指教 ! 謝謝 !

作者: samwang 時間: 2021-8-23 11:51

回復 2# ziv976688

我的困難點是在無法依第4段數字選擇"由大而小"的順序~
>> 由大至小開啟檔案，修改如下紅字部分，請測試看看，謝謝

Private Sub CommandButton1_Click()
Dim Path As String, a, Ar(1 To 1000, 1 To 2)
Nrange = "1878" ' InputBox("請輸入DATA!的開獎期數", "輸入期數")
Tm = Timer
[L1] = ""
Application.DisplayAlerts = False

Set fs = CreateObject("Scripting.FileSystemObject")
Path = ThisWorkbook.Path
a = Path & "\7C機"
Set f = fs.GetFolder(a)
Set fc = f.Files
For Each f1 In fc
      n = n + 1
      Ar(n, 1) = a & "\" & f1.Name
      Ar(n, 2) = Split(Split(f1.Name, "_")(3), "-")(0)
Next
For i = 1 To UBound(Ar)
For j = i + 1 To UBound(Ar)
      If Ar(i, 2) < Ar(j, 2) Then
         a = Ar(i, 1)
         Ar(i, 1) = Ar(j, 1)
         Ar(j, 1) = a
      End If
Next j
Next i
For i = 1 To n
      Set WB = Workbooks.Open(Ar(i, 1))
      WB.Close
Next


With Sheets("Sheet1")
      .[A1] = Nrange
      .[A2].Formula = "=CountA(M1:GZ1) / 2 & ""個""": .[A2] = .[A2].Value
      .[A3] = "開獎號碼"
...
...

作者: ziv976688 時間: 2021-8-23 12:37

回復 3# samwang
感謝您的指導

由大而小開啟檔案的需求~OK了~感恩

不好意思，可否勞駕您將各已開啟的檔案內之"機率表!"A&B二欄的內容複製後，
依序由主檔之"Sheet1!"的M1往右貼上的程式語法一併賜教。
謝謝您

作者: samwang 時間: 2021-8-23 13:19

回復 4# ziv976688

可否勞駕您將各已開啟的檔案內之"機率表!"A&B二欄的內容複製後，
依序由主檔之"Sheet1!"的M1往右貼上的程式語法一併賜教。
>> 程式如下紅字，請測試看看，謝謝

For i = 1 To UBound(Ar) '由大至小排序
For j = i + 1 To UBound(Ar)
      If Ar(i, 2) < Ar(j, 2) Then
         a = Ar(i, 1)
         Ar(i, 1) = Ar(j, 1)
         Ar(j, 1) = a
      End If
Next j
Next i

fileOrg = ActiveWorkbook.Name
C = 13
For i = 1 To n
      Set WB = Workbooks.Open(Ar(i, 1))
      With Sheets(1)
         If .FilterMode Then .ShowAllData
         .Range("a1:b" & .[a65536].End(3).Row).Copy Workbooks(fileOrg).Sheets("Sheet1").Cells(1, C)
         C = C + 2
      End With
      WB.Close
Next

With Sheets("Sheet1")
      .[A1] = Nrange
      .[A2].Formula = "=CountA(M1:GZ1) / 2 & ""個""": .[A2] = .[A2].Value
      .[A3] = "開獎號碼"
      .[A4:A10].Formula = "=IF(A$1="""","""",VLOOKUP(A$1,DATA!$A:$H,ROW()-2,

作者: ziv976688 時間: 2021-8-23 14:47

回復 5# samwang
OK了

謝謝您一再的指導和幫忙~感恩

作者: ziv976688 時間: 2021-8-23 21:35

本帖最後由 ziv976688 於 2021-8-23 21:39 編輯

回復 5# samwang
[attach]33946[/attach]
Samwang大大：您好!
想以 5#的貴解程式碼再進階：
請將原貴解：以各檔案名稱的第4段數字為基準(EX：7C機_1878期_100_1877-10_1次)~由大而小開啟的程式碼~
進階為：以各資料夾名稱的第5段數字為基準(EX：7C _0_1878期_100_1877-10_1次)~由大而小開啟的程式碼；
然後將各開啟後的資料夾中有關鍵字"機"的檔案(EX：7C機_1878期_100_1877-10_1次)開啟~
再將該開啟後的檔案內之"機率表"的A&B二欄內容複製後，
依序由主檔之"Sheet1!"的M1往右貼上。
請詳見7C_0_1878期_5個(效果檔)
PS：效果檔的內容與5樓的效果檔相同。

以上懇請賜教 ! 謝謝您 !

作者: samwang 時間: 2021-8-24 08:05

本帖最後由 samwang 於 2021-8-24 08:09 編輯

回復 7# ziv976688

以各資料夾名稱的第5段數字為基準(EX：7C _0_1878期_100_1877-10_1次)~由大而小開啟的程式碼；
然後將各開啟後的資料夾中有關鍵字"機"的檔案(EX：7C機_1878期_100_1877-10_1次)開啟~
再將該開啟後的檔案內之"機率表"的A&B二欄內容複製後，
依序由主檔之"Sheet1!"的M1往右貼上。
>> 程式如下，請測試看看，謝謝

Private Sub CommandButton1_Click()
Dim Path$, a, Ar(1 To 1000, 1 To 2), Ar1()
Nrange = "1878" ' InputBox("請輸入DATA!的開獎期數", "輸入期數")
Tm = Timer
[L1] = ""
Application.DisplayAlerts = False
Application.ScreenUpdating = False

Set fs = CreateObject("Scripting.FileSystemObject")
a = ThisWorkbook.Path    '每個資料夾名稱裝入Ar
Set f = fs.GetFolder(a)
Set fc = f.SubFolders
For Each f1 In fc
n = n + 1
Ar(n, 1) = f1.Path
Ar(n, 2) = Split(Split(f1.Name, "_")(4), "-")(0)
Next
For i = 1 To UBound(Ar) 'Ar由大至小排序
For j = i + 1 To UBound(Ar)
If Ar(i, 2) < Ar(j, 2) Then
      a = Ar(i, 1)
      Ar(i, 1) = Ar(j, 1)
      Ar(j, 1) = a
End If
Next j
Next i

For i = 1 To n          '開啟Ar，找檔名有"機"裝入Ar1
Set f = fs.GetFolder(Ar(i, 1))
Set fc = f.Files
For Each f1 In fc
      If InStr(f1.Path, "機") Then
         ReDim Preserve Ar1(n1)
         Ar1(n1) = f1.Path
         n1 = n1 + 1
      End If
Next f1
Next i

fileOrg = ActiveWorkbook.Name
C = 13
If n1 > 0 Then
For i1 = 0 To n - 1 '開啟Ar1，copy A、B欄資料到Sheet1 M欄開始往右
      Set WB = Workbooks.Open(Ar1(i1))
      With Sheets(1)
         If .FilterMode Then .ShowAllData
         .Range("a1:b" & .[a65536].End(3).Row).Copy Workbooks(fileOrg).Sheets("Sheet1").Cells(1, C)
         C = C + 2
      End With
      WB.Close
Next
End If
Set fs = Nothing: Set f = Nothing: Set fc = Nothing


With Sheets("Sheet1")
.[A1] = Nrange
...
...

作者: ziv976688 時間: 2021-8-24 08:57

本帖最後由 ziv976688 於 2021-8-24 09:15 編輯

回復 8# samwang
samwang大大 : 您好 !
感謝賜教

[attach]33947[/attach]
測試後，在列33 ReDim Preserve Ar1(n1) 編輯錯誤(變數未定義)
請問 : 這個變數要怎麼下定義?

Private Sub CommandButton1_Click()
Dim Path As String, a, Ar(1 To 1000, 1 To 2), Ar1( )
這樣對嗎?
謝謝您

作者: samwang 時間: 2021-8-24 09:27

本帖最後由 samwang 於 2021-8-24 09:34 編輯

回復 9# ziv976688

對要定義，8#有反紅色有定義，請再測試看看，謝謝
Dim Path As String, a, Ar(1 To 1000, 1 To 2), Ar1( )

作者: ziv976688 時間: 2021-8-24 09:37

回復 10# samwang
Sorry~原來是我在貼8#的程式碼時，就疏忽遺漏了

所有需要人工操作的部分~都以程式碼完成替代並測試成功

萬分感激您的耐心指導和熱心幫忙~受惠良多~感恩

作者: ziv976688 時間: 2021-8-31 09:53

本帖最後由 ziv976688 於 2021-8-31 10:06 編輯

回復 10# samwang
請修正程式碼
[attach]33960[/attach]
不好意思~將http://forum.twbts.com/viewthrea ... a=pageD1&page=2 10樓修正後的程式碼，
貼上本題主檔的程式碼列55套用，會在列62 For j = 2 To 8: n = n + 1: Brr(n) = Arr(i, j): Next 中斷(陣列索引超出範圍)。
不知要如何修正?才能讓Sheet1!C : K產生正確答案。
以上懇請賜正。謝謝您

作者: samwang 時間: 2021-8-31 10:36

回復 12# ziv976688

貼上本題主檔的程式碼列55套用，會在列62 For j = 2 To 8: n = n + 1: Brr(n) = Arr(i, j): Next 中斷(陣列索引超出範圍)。

>> 因為 n 前面程式碼已有使用過且有數值，所以將n改m 即可，For j = 2 To 8: m = m + 1: Brr(m) = Arr(i, j): Next ,謝謝

作者: ziv976688 時間: 2021-8-31 11:25

回復 13# samwang
samwang大大 :
OK了!
謝謝您不厭其煩的指導和幫忙~感恩

歡迎光臨麻辣家族討論版版 (http://forum.twbts.com/)