麻辣家族討論版版 » Excel程式區 » 使用儲存格設定來指定活頁

蘿蔔泥 發表於 2021-12-8 15:23

使用儲存格設定來指定活頁

各位大大好

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

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

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

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

i = 2
If Range("a2") = "" Then
    r = 2
Else
    r = Range("a1").End(xlDown).Row + 1
End If

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

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

        End If
    r = r + 1
    i = i + 1
Loop

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

End Sub[/code]

samwang 發表於 2021-12-8 16:28

[b]回復 [url=http://forum.twbts.com/redirect.php?goto=findpost&pid=117952&ptid=23509]1#[/url] [i]蘿蔔泥[/i] [/b]

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

另外想請問有辦法不打開活頁簿就能抓取資料出來嗎？
[color=Blue]>> 可以開啟檔案後資料裝入陣列就關閉檔案，然後最後做資料處理，這樣應該很快才對。[/color]

蘿蔔泥 發表於 2021-12-8 17:14

[b]回復 [url=http://forum.twbts.com/redirect.php?goto=findpost&pid=117955&ptid=23509]2#[/url] [i]samwang[/i] [/b]


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

另外想請問有辦法不打開活頁簿就能抓取資料出來嗎？
>> 可以開啟檔案後資料裝入陣列就關閉檔案，然後最後做資料處理，這樣應該很快才對。
[color=RoyalBlue]>>不好意思，請我該怎寫呢？[/color]

samwang 發表於 2021-12-9 09:28

[b]回復 [url=http://forum.twbts.com/redirect.php?goto=findpost&pid=117957&ptid=23509]3#[/url] [i]蘿蔔泥[/i] [/b]

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

蘿蔔泥 發表於 2021-12-13 09:29

[b]回復 [url=http://forum.twbts.com/redirect.php?goto=findpost&pid=117966&ptid=23509]4#[/url] [i]samwang[/i] [/b]


  您好，因為我的資料夾裡面不只一個excel檔，可以用指定的方式嗎？
  Workbooks("[color=SeaGreen]1.年度訓練總表-109[/color]")-->>這個能隨設定頁變動嗎？

samwang 發表於 2021-12-13 10:02

[quote]回復  samwang
您好，因為我的資料夾裡面不只一個excel檔，可以用指定的方式嗎？
  Workbooks("1. ...
[size=2][color=#999999]蘿蔔泥 發表於 2021-12-13 09:29[/color] [url=http://forum.twbts.com/redirect.php?goto=findpost&pid=118028&ptid=23509][img]http://forum.twbts.com/images/common/back.gif[/img][/url][/size][/quote]

改用選擇檔案方式，請測試看看，謝謝
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

[b]回復 [url=http://forum.twbts.com/redirect.php?goto=findpost&pid=118029&ptid=23509]6#[/url] [i]samwang[/i] [/b]


好的，謝謝，最近比較忙我會再找時間測試
另外想請問Workbooks("[color=DeepSkyBlue]1.年度訓練總表-109[/color]")-->>這個能隨設定頁變動嗎？

samwang 發表於 2021-12-14 15:25

[quote]回復  samwang
好的，謝謝，最近比較忙我會再找時間測試
另外想請問Workbooks("1.年度訓練總表-10 ...
[size=2][color=#999999]蘿蔔泥 發表於 2021-12-14 14:56[/color] [url=http://forum.twbts.com/redirect.php?goto=findpost&pid=118047&ptid=23509][img]http://forum.twbts.com/images/common/back.gif[/img][/url][/size][/quote]

另外想請問Workbooks("1.年度訓練總表-109")-->>這個能隨設定頁變動嗎？
[color=Blue]>> 不太能了解您的意思，可舉例一些範例嗎? 謝謝[/color]

蘿蔔泥 發表於 2021-12-30 17:09

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

i = 2
If Range("a2") = "" Then
    r = 2
Else
    r = Range("a1").End(xlDown).Row + 1
End If

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

Do While Range("a" & i) <> ""
    Workbooks("2.年度訓練計畫表").Sheets("連結總表").Cells(r, 1) = Workbooks("SNAME").Sheets("總表").Range("a" & i)
    Workbooks("2.年度訓練計畫表").Sheets("連結總表").Cells(r, 2) = Workbooks("SNAME").Sheets("總表").Range("e" & i)
    Workbooks("2.年度訓練計畫表").Sheets("連結總表").Cells(r, 3) = Workbooks("SNAME").Sheets("總表").Range("f" & i)
    Workbooks("2.年度訓練計畫表").Sheets("連結總表").Cells(r, 4) = Workbooks("SNAME").Sheets("總表").Range("j" & i)
    Workbooks("2.年度訓練計畫表").Sheets("連結總表").Cells(r, 5) = Workbooks("SNAME").Sheets("總表").Range("i" & i)
    Workbooks("2.年度訓練計畫表").Sheets("連結總表").Cells(r, 6) = Workbooks("SNAME").Sheets("總表").Range("d" & i)
    Workbooks("2.年度訓練計畫表").Sheets("連結總表").Cells(r, 7) = Workbooks("SNAME").Sheets("總表").Range("l" & i)
    Workbooks("2.年度訓練計畫表").Sheets("連結總表").Cells(r, 8) = Workbooks("SNAME").Sheets("總表").Range("m" & i)
    Workbooks("2.年度訓練計畫表").Sheets("連結總表").Cells(r, 9) = Workbooks("SNAME").Sheets("總表").Range("q" & i)
    Workbooks("2.年度訓練計畫表").Sheets("連結總表").Cells(r, 10) = Workbooks("SNAME").Sheets("總表").Range("t" & i)
    Workbooks("2.年度訓練計畫表").Sheets("連結總表").Cells(r, 11) = Workbooks("SNAME").Sheets("總表").Range("ab" & i)
    Workbooks("2.年度訓練計畫表").Sheets("連結總表").Cells(r, 12) = Workbooks("SNAME").Sheets("總表").Range("y" & i)
    Workbooks("2.年度訓練計畫表").Sheets("連結總表").Cells(r, 13) = Workbooks("SNAME").Sheets("總表").Range("z" & i)
'    Workbooks("2.年度訓練計畫表").Worksheets("連結總表").Cells(r, 14) = Workbooks("SNAME").Sheets("總表").Range("aa" & i)
        If Workbooks("SNAME").Sheets("總表").Range("j" & i) = "外訓" And Workbooks("SNAME").Sheets("總表").Range("q" & i) <> "" Then
            Workbooks("2.年度訓練計畫表").Sheets("連結總表").Cells(r, 14) = "詳如明細"
        Else
            Workbooks("2.年度訓練計畫表").Sheets("連結總表").Cells(r, 14) = Workbooks("SNAME").Sheets("總表").Range("aa" & i)

        End If
    r = r + 1
    i = i + 1
Loop

Workbooks(SNAME).Close
'x = WorksheetFunction.CountIf(Sheets("連結總表").Range("c:d"), Range("m:m"))
End Sub
[/code]

samwang 發表於 2022-1-4 11:26

[i=s] 本帖最後由 samwang 於 2022-1-4 11:28 編輯 [/i]

[quote]請問是哪裡出錯了嗎？一直出現執行錯誤
[size=2][color=#999999]蘿蔔泥 發表於 2021-12-30 17:09[/color] [url=http://forum.twbts.com/redirect.php?goto=findpost&pid=118158&ptid=23509][img]http://forum.twbts.com/images/common/back.gif[/img][/url][/size][/quote]

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

蘿蔔泥 發表於 2022-1-5 13:50

[b]回復 [url=http://forum.twbts.com/redirect.php?goto=findpost&pid=118182&ptid=23509]10#[/url] [i]samwang[/i] [/b]


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

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

i = 2
If Range("a2") = "" Then
    r = 2
Else
    r = Range("a1").End(xlDown).Row + 1
End If
MsgBox (r)

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

Do While Range("a" & i) <> ""
    Workbooks("2.年度訓練計畫表").Sheets("連結總表").Cells(r, 1) = Workbooks("SNAME").Sheets("總表").Range("a" & i)
    Workbooks("2.年度訓練計畫表").Sheets("連結總表").Cells(r, 2) = Workbooks("SNAME").Sheets("總表").Range("e" & i)
    Workbooks("2.年度訓練計畫表").Sheets("連結總表").Cells(r, 3) = Workbooks("SNAME").Sheets("總表").Range("f" & i)
    Workbooks("2.年度訓練計畫表").Sheets("連結總表").Cells(r, 4) = Workbooks("SNAME").Sheets("總表").Range("j" & i)
    Workbooks("2.年度訓練計畫表").Sheets("連結總表").Cells(r, 5) = Workbooks("SNAME").Sheets("總表").Range("i" & i)
    Workbooks("2.年度訓練計畫表").Sheets("連結總表").Cells(r, 6) = Workbooks("SNAME").Sheets("總表").Range("d" & i)
    Workbooks("2.年度訓練計畫表").Sheets("連結總表").Cells(r, 7) = Workbooks("SNAME").Sheets("總表").Range("l" & i)
    Workbooks("2.年度訓練計畫表").Sheets("連結總表").Cells(r, 8) = Workbooks("SNAME").Sheets("總表").Range("m" & i)
    Workbooks("2.年度訓練計畫表").Sheets("連結總表").Cells(r, 9) = Workbooks("SNAME").Sheets("總表").Range("q" & i)
    Workbooks("2.年度訓練計畫表").Sheets("連結總表").Cells(r, 10) = Workbooks("SNAME").Sheets("總表").Range("t" & i)
    Workbooks("2.年度訓練計畫表").Sheets("連結總表").Cells(r, 11) = Workbooks("SNAME").Sheets("總表").Range("ab" & i)
    Workbooks("2.年度訓練計畫表").Sheets("連結總表").Cells(r, 12) = Workbooks("SNAME").Sheets("總表").Range("y" & i)
    Workbooks("2.年度訓練計畫表").Sheets("連結總表").Cells(r, 13) = Workbooks("SNAME").Sheets("總表").Range("z" & i)
'    Workbooks("2.年度訓練計畫表").Worksheets("連結總表").Cells(r, 14) = Workbooks("SNAME").Sheets("總表").Range("aa" & i)
        If Workbooks("SNAME").Sheets("總表").Range("j" & i) = "外訓" And Workbooks("SNAME").Sheets("總表").Range("q" & i) <> "" Then
            Workbooks("2.年度訓練計畫表").Sheets("連結總表").Cells(r, 14) = "詳如明細"
        Else
            Workbooks("2.年度訓練計畫表").Sheets("連結總表").Cells(r, 14) = Workbooks("SNAME").Sheets("總表").Range("aa" & i)

        End If
    r = r + 1
    i = i + 1
Loop

Workbooks(SNAME).Close
'x = WorksheetFunction.CountIf(Sheets("連結總表").Range("c:d"), Range("m:m"))
End Sub
[/code]

rakefrank 發表於 2022-1-10 15:39

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

查看完整版本: 使用儲存格設定來指定活頁