Board logo

標題: [發問] 使用儲存格設定來指定活頁 [打印本頁]
作者: 蘿蔔泥    時間: 2021-12-8 15:23     標題: 使用儲存格設定來指定活頁

各位大大好

我有兩個檔案，
一個是"1.年度訓練總表-109"，後面的109會隨年度不同而改變
另一個"2.年度訓練計畫表"
"2.年度訓練計畫表"會去抓"1.年度訓練總表-109"的資料來做整理，

目前我有重新修改一下巨集"完成_總結new()"
在"2.年度訓練計畫表"有做一個設定頁，變更年度會開啟那個年度的資料
但要執行Do While的時候我還是要一個個修改成我要的年度
舉例之前是"1.年度訓練總表-108"我就要進去改成"1.年度訓練總表-109"
這個是不是也能參照設定頁的資訊呢？

另外想請問有辦法不打開活頁簿就能抓取資料出來嗎？

巨集寫得有點亂還請見諒
  1. Sub 完成_總結new()

  3. i = 2
  4. If Range("a2") = "" Then
  5.     r = 2
  6. Else
  7.     r = Range("a1").End(xlDown).Row + 1
  8. End If

  10. Workbooks.Open Filename:=Sheets("設定頁").Range("B5")

  12. Do While Range("a" & i) <> ""
  13.     Workbooks("2.年度訓練計畫表").Worksheets("連結總表").Cells(r, 1) = Workbooks("1.年度訓練總表-109").Sheets("總表").Range("a" & i)
  14.     Workbooks("2.年度訓練計畫表").Worksheets("連結總表").Cells(r, 2) = Workbooks("1.年度訓練總表-109").Sheets("總表").Range("e" & i)
  15.     Workbooks("2.年度訓練計畫表").Worksheets("連結總表").Cells(r, 3) = Workbooks("1.年度訓練總表-109").Sheets("總表").Range("f" & i)
  16.     Workbooks("2.年度訓練計畫表").Worksheets("連結總表").Cells(r, 4) = Workbooks("1.年度訓練總表-109").Sheets("總表").Range("j" & i)
  17.     Workbooks("2.年度訓練計畫表").Worksheets("連結總表").Cells(r, 5) = Workbooks("1.年度訓練總表-109").Sheets("總表").Range("i" & i)
  18.     Workbooks("2.年度訓練計畫表").Worksheets("連結總表").Cells(r, 6) = Workbooks("1.年度訓練總表-109").Sheets("總表").Range("d" & i)
  19.     Workbooks("2.年度訓練計畫表").Worksheets("連結總表").Cells(r, 7) = Workbooks("1.年度訓練總表-109").Sheets("總表").Range("l" & i)
  20.     Workbooks("2.年度訓練計畫表").Worksheets("連結總表").Cells(r, 8) = Workbooks("1.年度訓練總表-109").Sheets("總表").Range("m" & i)
  21.     Workbooks("2.年度訓練計畫表").Worksheets("連結總表").Cells(r, 9) = Workbooks("1.年度訓練總表-109").Sheets("總表").Range("q" & i)
  22.     Workbooks("2.年度訓練計畫表").Worksheets("連結總表").Cells(r, 10) = Workbooks("1.年度訓練總表-109").Sheets("總表").Range("t" & i)
  23.     Workbooks("2.年度訓練計畫表").Worksheets("連結總表").Cells(r, 11) = Workbooks("1.年度訓練總表-109").Sheets("總表").Range("ab" & i)
  24.     Workbooks("2.年度訓練計畫表").Worksheets("連結總表").Cells(r, 12) = Workbooks("1.年度訓練總表-109").Sheets("總表").Range("y" & i)
  25.     Workbooks("2.年度訓練計畫表").Worksheets("連結總表").Cells(r, 13) = Workbooks("1.年度訓練總表-109").Sheets("總表").Range("z" & i)
  26. '    Workbooks("2.年度訓練計畫表").Worksheets("連結總表").Cells(r, 14) = Workbooks("1.年度訓練總表-109").Sheets("總表").Range("aa" & i)
  27.         If Workbooks("1.年度訓練總表-109").Sheets("總表").Range("j" & i) = "外訓" And Workbooks("1.年度訓練總表-109").Sheets("總表").Range("q" & i) <> "" Then
  28.             Workbooks("2.年度訓練計畫表").Worksheets("連結總表").Cells(r, 14) = "詳如明細"
  29.         Else
  30.             Workbooks("2.年度訓練計畫表").Worksheets("連結總表").Cells(r, 14) = Workbooks("1.年度訓練總表-109").Sheets("總表").Range("aa" & i)

  32.         End If
  33.     r = r + 1
  34.     i = i + 1
  35. Loop

  37. Workbooks("1.年度訓練總表-109").Close

  39. End Sub
複製代碼
作者: samwang    時間: 2021-12-8 16:28

回復 1# 蘿蔔泥

這個是不是也能參照設定頁的資訊呢？
>> 這是什麼意思? 你的設定頁B1已有年度，這不是很好嗎?
另外也可以將2個檔案同時放在同一個資料夾，這樣就不用設定年度，可以直接開啟另一個檔案

另外想請問有辦法不打開活頁簿就能抓取資料出來嗎？
>> 可以開啟檔案後資料裝入陣列就關閉檔案，然後最後做資料處理，這樣應該很快才對。
作者: 蘿蔔泥    時間: 2021-12-8 17:14

回復 2# samwang


這個是不是也能參照設定頁的資訊呢？
>> 這是什麼意思? 你的設定頁B1已有年度，這不是很好嗎?>>不好意思，我不太懂你的意思
另外也可以將2個檔案同時放在同一個資料夾，這樣就不用設定年度，可以直接開啟另一個檔案
>>是放在同一個年度的資料夾裡，
我寫不出來的是 Workbooks("2.年度訓練計畫表").Worksheets("連結總表").Cells(r, 1) = Workbooks("1.年度訓練總表-109").Sheets("總表").Range("a" & i)
要如何讓Workbooks("1.年度訓練總表-109")跟著設定頁變動


另外想請問有辦法不打開活頁簿就能抓取資料出來嗎？
>> 可以開啟檔案後資料裝入陣列就關閉檔案，然後最後做資料處理，這樣應該很快才對。
>>不好意思，請我該怎寫呢？
作者: samwang    時間: 2021-12-9 09:28

回復 3# 蘿蔔泥

是放在同一個年度的資料夾裡，
我寫不出來的是 Workbooks("2.年度訓練計畫表").Worksheets("連結總表").Cells(r, 1) = Workbooks("1.年度訓練總表-109").Sheets("總表").Range("a" & i)
要如何讓Workbooks("1.年度訓練總表-109")跟著設定頁變動
>> 2個檔案放在同一個資料夾，只要開啟"2.年度訓練計畫表"就會自動抓取"1.年度訓練總表-109"資料，請測試看看，謝謝
作者: 蘿蔔泥    時間: 2021-12-13 09:29

回復 4# samwang


  您好，因為我的資料夾裡面不只一個excel檔，可以用指定的方式嗎？
  Workbooks("1.年度訓練總表-109")-->>這個能隨設定頁變動嗎？
作者: samwang    時間: 2021-12-13 10:02

回復  samwang
您好，因為我的資料夾裡面不只一個excel檔，可以用指定的方式嗎？
  Workbooks("1. ...
蘿蔔泥 發表於 2021-12-13 09:29


改用選擇檔案方式，請測試看看，謝謝
Sub test()
Dim FileOrg$, fc%, wb, a, Dr, Sr, j%
Application.ScreenUpdating = False: Application.DisplayAlerts = False
FileOrg = ActiveWorkbook.Name
Sheets("連結總表").[a1].CurrentRegion.Offset(1) = ""
With Application.FileDialog(msoFileDialogOpen)
    .InitialFileName = "D:\"
    .Title = "===========選擇  ""年度訓練總表""  檔案==========="
    .AllowMultiSelect = False: .Show
    fc = .SelectedItems.Count: If fc = 0 Then Exit Sub
    a = .SelectedItems(1)
    Set wb = Workbooks.Open(a)
    With Sheets("總表")
        If .FilterMode Then .ShowAllData
        Set xA = .[a1]
        R = xA(Rows.Count, 1).End(xlUp).Row
        Dr = Array(1, 5, 6, 10, 9, 4, 12, 13, 17, 20, 28, 25, 26, 27)   '資料來源
        Sr = Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14)       '順序
        For j = 0 To UBound(Dr)
            Workbooks(FileOrg).Sheets("連結總表").Cells(2, Sr(j)).Resize(R).Value = xA(2, Dr(j)).Resize(R).Value
        Next
    End With
End With
wb.Close
Set wb = Nothing:  Set xA = Nothing
Application.ScreenUpdating = True: Application.DisplayAlerts = True
End Sub
作者: 蘿蔔泥    時間: 2021-12-14 14:56

回復 6# samwang


好的，謝謝，最近比較忙我會再找時間測試
另外想請問Workbooks("1.年度訓練總表-109")-->>這個能隨設定頁變動嗎？
作者: samwang    時間: 2021-12-14 15:25

回復  samwang
好的，謝謝，最近比較忙我會再找時間測試
另外想請問Workbooks("1.年度訓練總表-10 ...
蘿蔔泥 發表於 2021-12-14 14:56


另外想請問Workbooks("1.年度訓練總表-109")-->>這個能隨設定頁變動嗎？
>> 不太能了解您的意思，可舉例一些範例嗎? 謝謝
作者: 蘿蔔泥    時間: 2021-12-30 17:09

請問是哪裡出錯了嗎？一直出現執行錯誤
  1. Sub 完成_總結new()

  3. i = 2
  4. If Range("a2") = "" Then
  5.     r = 2
  6. Else
  7.     r = Range("a1").End(xlDown).Row + 1
  8. End If

  10. SNAME = Sheets("設定頁").Range("B5")
  11. Workbooks.Open Filename:=SNAME

  13. Do While Range("a" & i) <> ""
  14.     Workbooks("2.年度訓練計畫表").Sheets("連結總表").Cells(r, 1) = Workbooks("SNAME").Sheets("總表").Range("a" & i)
  15.     Workbooks("2.年度訓練計畫表").Sheets("連結總表").Cells(r, 2) = Workbooks("SNAME").Sheets("總表").Range("e" & i)
  16.     Workbooks("2.年度訓練計畫表").Sheets("連結總表").Cells(r, 3) = Workbooks("SNAME").Sheets("總表").Range("f" & i)
  17.     Workbooks("2.年度訓練計畫表").Sheets("連結總表").Cells(r, 4) = Workbooks("SNAME").Sheets("總表").Range("j" & i)
  18.     Workbooks("2.年度訓練計畫表").Sheets("連結總表").Cells(r, 5) = Workbooks("SNAME").Sheets("總表").Range("i" & i)
  19.     Workbooks("2.年度訓練計畫表").Sheets("連結總表").Cells(r, 6) = Workbooks("SNAME").Sheets("總表").Range("d" & i)
  20.     Workbooks("2.年度訓練計畫表").Sheets("連結總表").Cells(r, 7) = Workbooks("SNAME").Sheets("總表").Range("l" & i)
  21.     Workbooks("2.年度訓練計畫表").Sheets("連結總表").Cells(r, 8) = Workbooks("SNAME").Sheets("總表").Range("m" & i)
  22.     Workbooks("2.年度訓練計畫表").Sheets("連結總表").Cells(r, 9) = Workbooks("SNAME").Sheets("總表").Range("q" & i)
  23.     Workbooks("2.年度訓練計畫表").Sheets("連結總表").Cells(r, 10) = Workbooks("SNAME").Sheets("總表").Range("t" & i)
  24.     Workbooks("2.年度訓練計畫表").Sheets("連結總表").Cells(r, 11) = Workbooks("SNAME").Sheets("總表").Range("ab" & i)
  25.     Workbooks("2.年度訓練計畫表").Sheets("連結總表").Cells(r, 12) = Workbooks("SNAME").Sheets("總表").Range("y" & i)
  26.     Workbooks("2.年度訓練計畫表").Sheets("連結總表").Cells(r, 13) = Workbooks("SNAME").Sheets("總表").Range("z" & i)
  27. '    Workbooks("2.年度訓練計畫表").Worksheets("連結總表").Cells(r, 14) = Workbooks("SNAME").Sheets("總表").Range("aa" & i)
  28.         If Workbooks("SNAME").Sheets("總表").Range("j" & i) = "外訓" And Workbooks("SNAME").Sheets("總表").Range("q" & i) <> "" Then
  29.             Workbooks("2.年度訓練計畫表").Sheets("連結總表").Cells(r, 14) = "詳如明細"
  30.         Else
  31.             Workbooks("2.年度訓練計畫表").Sheets("連結總表").Cells(r, 14) = Workbooks("SNAME").Sheets("總表").Range("aa" & i)

  33.         End If
  34.     r = r + 1
  35.     i = i + 1
  36. Loop

  38. Workbooks(SNAME).Close
  39. 'x = WorksheetFunction.CountIf(Sheets("連結總表").Range("c:d"), Range("m:m"))
  40. End Sub
複製代碼
作者: samwang    時間: 2022-1-4 11:26

本帖最後由 samwang 於 2022-1-4 11:28 編輯
請問是哪裡出錯了嗎？一直出現執行錯誤
蘿蔔泥 發表於 2021-12-30 17:09


我用之前提供6#程式碼執行結果無誤如圖片，都有符合您的需求，
選檔案-->然後複製資料-->貼到"連結總表"
請再測試看看，謝謝
作者: 蘿蔔泥    時間: 2022-1-5 13:50

回復 10# samwang


您好，謝謝您
共同作業的人員希望先改為以下的方式操作，
因太深的巨集他無法了解且之後他無法做修改，
故我們討論後只好將原本巨集做了簡單調整方便他日後做維護，
但出現執行錯誤，陣列索引超出範圍
因我們找不出錯誤原因為何，
故想請教大大幫忙

您之前所提供的巨集，我會留下作個人使用，謝謝
  1. Sub 完成_總結new()

  3. i = 2
  4. If Range("a2") = "" Then
  5.     r = 2
  6. Else
  7.     r = Range("a1").End(xlDown).Row + 1
  8. End If
  9. MsgBox (r)

  11. SNAME = Sheets("設定頁").Range("B5")
  12. Workbooks.Open Filename:=SNAME

  14. Do While Range("a" & i) <> ""
  15.     Workbooks("2.年度訓練計畫表").Sheets("連結總表").Cells(r, 1) = Workbooks("SNAME").Sheets("總表").Range("a" & i)
  16.     Workbooks("2.年度訓練計畫表").Sheets("連結總表").Cells(r, 2) = Workbooks("SNAME").Sheets("總表").Range("e" & i)
  17.     Workbooks("2.年度訓練計畫表").Sheets("連結總表").Cells(r, 3) = Workbooks("SNAME").Sheets("總表").Range("f" & i)
  18.     Workbooks("2.年度訓練計畫表").Sheets("連結總表").Cells(r, 4) = Workbooks("SNAME").Sheets("總表").Range("j" & i)
  19.     Workbooks("2.年度訓練計畫表").Sheets("連結總表").Cells(r, 5) = Workbooks("SNAME").Sheets("總表").Range("i" & i)
  20.     Workbooks("2.年度訓練計畫表").Sheets("連結總表").Cells(r, 6) = Workbooks("SNAME").Sheets("總表").Range("d" & i)
  21.     Workbooks("2.年度訓練計畫表").Sheets("連結總表").Cells(r, 7) = Workbooks("SNAME").Sheets("總表").Range("l" & i)
  22.     Workbooks("2.年度訓練計畫表").Sheets("連結總表").Cells(r, 8) = Workbooks("SNAME").Sheets("總表").Range("m" & i)
  23.     Workbooks("2.年度訓練計畫表").Sheets("連結總表").Cells(r, 9) = Workbooks("SNAME").Sheets("總表").Range("q" & i)
  24.     Workbooks("2.年度訓練計畫表").Sheets("連結總表").Cells(r, 10) = Workbooks("SNAME").Sheets("總表").Range("t" & i)
  25.     Workbooks("2.年度訓練計畫表").Sheets("連結總表").Cells(r, 11) = Workbooks("SNAME").Sheets("總表").Range("ab" & i)
  26.     Workbooks("2.年度訓練計畫表").Sheets("連結總表").Cells(r, 12) = Workbooks("SNAME").Sheets("總表").Range("y" & i)
  27.     Workbooks("2.年度訓練計畫表").Sheets("連結總表").Cells(r, 13) = Workbooks("SNAME").Sheets("總表").Range("z" & i)
  28. '    Workbooks("2.年度訓練計畫表").Worksheets("連結總表").Cells(r, 14) = Workbooks("SNAME").Sheets("總表").Range("aa" & i)
  29.         If Workbooks("SNAME").Sheets("總表").Range("j" & i) = "外訓" And Workbooks("SNAME").Sheets("總表").Range("q" & i) <> "" Then
  30.             Workbooks("2.年度訓練計畫表").Sheets("連結總表").Cells(r, 14) = "詳如明細"
  31.         Else
  32.             Workbooks("2.年度訓練計畫表").Sheets("連結總表").Cells(r, 14) = Workbooks("SNAME").Sheets("總表").Range("aa" & i)

  34.         End If
  35.     r = r + 1
  36.     i = i + 1
  37. Loop

  39. Workbooks(SNAME).Close
  40. 'x = WorksheetFunction.CountIf(Sheets("連結總表").Range("c:d"), Range("m:m"))
  41. End Sub
複製代碼
作者: rakefrank    時間: 2022-1-10 15:39

先開1.年度訓練總表-109.xlsm
再開2.年度訓練計畫表.xlsm
執行



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