johnny
Lv 4
johnny asked in 電腦與網際網路軟體 · 1 decade ago

VBA~以基本資料表自動複製需求檔案。

如題︰

範例附檔︰http://www.FunP.Net/907745

因常常需要製作固定格式內容的檔案,所以希望能以VBA(巨集)達到需求,

煩請各位EXCEL大師、達人能予以協助。謝謝!

問題需求︰

在基本資料表設定一個執行複製的按鈕,當按該執行複製的按鈕後,

即可自動複製出一個新檔案(詳如需求檔案),

1. 複製完成後之新檔案是個別獨立的(即與基本資料表檔案是分開的)。

2. 自動複製出的檔案,是一個不含有巨集的一般型式之檔案。

3. 希望完成後設有執行複製按鈕的巨集檔案可以重複使用,

即如在完成的基本資料巨集檔案,再貼上新的基本資料內容後,

重新按一次執行複製的按鈕,則自動又會複製出另一個新的需求檔案

以上需求

尚請各位EXCEL大師、達人不吝指教。

謝謝!

Update:

TO︰worlonzeng大師

謝謝點數熱情贊助。^^

Update 2:

TO︰阿玲大大

謝謝點數熱情贊助。^^

Update 3:

製作需求檔時忘了貼上公式,尚請見諒!

如果解題者認為有其它相同需求精神的公式,

小弟竭誠歡迎解題者使用自己擅長或習慣的類型之公式。

附上有貼上公式之需求檔。

謹請參考。謝謝!

http://www.FunP.Net/289002

Update 4:

TO︰夏日兄

勞駕將您最後一個解答意見移置回答欄,

無法顯示效果的原因是小弟的版本太舊了。^_^

2 Answers

Rating
  • 夏日
    Lv 5
    1 decade ago
    Favorite Answer

    此題的條件還不少,其實並不會太難,只是步驟不少,如果都不含公式的話,此題應該在1秒內就能跑完了。看裡面的條件加上我猜想要的結果。產生一個xls檔裡面含7個sheet,各sheet都是最近一期的號碼交叉比對。

    不知有沒有大大願意做的?

    2008-11-27 21:00:24 補充:

    為何需要公式呢?下面的檔案是vba產生後的檔案,已經經過交叉比對後的資料。

    http://www.FunP.Net/146820

    2008-11-27 22:11:41 補充:

    我剛沒上傳只是試試看這是不是想要 的。

    http://www.funp.net/918060

    2008-11-28 00:00:31 補充:

    基本資料檔與需求檔顛倒了?

    是指產生的sheet上面的數字要反排是嗎?

    裡面有加手動計算了。

    http://www.FunP.Net/628387

    2008-11-28 00:57:58 補充:

    把p欄後資料砍了就行了選中p欄以後的資料按delete,不要用刪除欄的方式就行了。

    我會在那放資料是因為要借表格屬性。不然光設這屬性又要跑不少設定。

    產生的七個sheet應該是沒有錯的吧內容應該也是一樣的吧?

    下面這檔是清掉了不少但最右邊還是有一個定位點。

    http://www.funp.net/718139

    先來睡。

    2008-11-28 10:03:37 補充:

    稍有差異處是否指的是00那格,建議Johnny兄把製作完後的範本覺的那裡有問題的圈選出來,不然又一堆數字看了很頭痛。

    2008-11-28 11:21:09 補充:

    真是雞同鴨講了,我在我的2007裡面執行出來的結果就是ggg檔,在您那跑出來竟是空的,不知那個語句的問題了。

    2008-11-28 11:30:26 補充:

    我上傳我最後的版本,及結果表,如果要修我還不知怎修,沒有2003版可用,不然就要請人幫抓bug了!,難怪您之前的發言一直搞的我看不懂。

    http://www.FunP.Net/448151

    2008-11-28 13:23:57 補充:

    加了很多不必要的語句,還是不行就找別人解了!

    http://www.funp.net/956939

    2008-11-28 14:46:34 補充:

    此段VBA在2007顯示正確無誤,只因版本問題導致顯示結果不一致,如果有2003版的其實小修一下很快OK,但沒有此版本可以修,故再另找高手幫忙了。

    Sub gg()

    t = Timer

    Dim x%, i%, z%, g%, arr, arr1, arr2, sh As Worksheet

    On Error Resume Next

    Application.Calculation = xlCalculationManual

    Application.ScreenUpdating = False

    Application.DisplayAlerts = False

    ActiveSheet.UsedRange.Copy

    Workbooks.Add

    ActiveSheet.Paste

    [Q:IV] = ""

    x = [a655536].End(xlUp).Row

    arr = Cells(x, 1).Resize(, 8)

    arr1 = Range(Cells(6, 1), Cells(x, 8))

    For Each sh In Sheets

    If sh.Name <> Sheets(1).Name Then sh.Delete

    Next

    Cells.Columns("A:S").ColumnWidth = 4.3

    ActiveSheet.Shapes("Button 1").Delete

    Cells(3, 17) = arr(1, 1)

    Cells(4, 17) = arr(1, 1) + 1

    For i = 1 To 6

    Sheets(Sheets.Count).Copy before:=Sheets(1)

    Sheets(1).Name = "Sheet" & i + 1

    Next

    h = 9

    For Each sh In Sheets

    ReDim arr2(1 To 100, 1 To 3)

    h = h - 1

    z = 1

    sh.Activate

    Cells(4, 18) = arr(1, h)

    For i = 1 To UBound(arr1)

    For g = 2 To 8

    If arr1(i, g) = arr(1, h) Then

    arr2(z, 2) = arr1(i, 1)

    arr2(z, 1) = arr(1, 1) + 1 - arr2(z, 2)

    arr2(z, 3) = arr1(1 + i, g)

    z = z + 1

    End If

    Next

    Next

    Cells(5, 17).Resize(z, 3) = arr2

    Cells(2, 20).Resize(3, z) = WorksheetFunction.Transpose(arr2)

    Application.Goto [a1], True

    Next

    Sheets(7).Select

    [G1] = Format(Timer - t, "0.0000") & "秒"

    Application.DisplayAlerts = True

    Application.ScreenUpdating = True

    End Sub

  • johnny
    Lv 4
    1 decade ago

    RE︰夏兄

    如果不嫌棄的話,

    就勞駕您爲小弟『解難』。

    感恩囉~

    2008-11-27 21:19:16 補充:

    RE︰夏日兄

    不好意思,因小弟對VBA的基本需求尚無概念,又不便多問,免得惹人厭煩,所以先附上先,

    用不用得上都沒有關係。^^

    範例檔以下載,謝謝您。但似乎少了一個基本資料與執行按鈕,不知如何去測試與驗證?

    還是………小弟的無知,又出糗了。^^

    2008-11-27 23:26:50 補充:

    RE︰夏日兄

    不好意思,有事外出一下。尚請包涵。

    好像是基本資料檔與需求檔顛倒了?

    另外是否可以再加一個自動改為手動的步驟程式碼,

    小弟總是忘了先將自動改為手動就按執行鈕。^_^

    謝謝您!

    2008-11-28 00:26:21 補充:

    RE︰夏日兄

    小弟說的是︰基本資料檔只有單Sheet,內容是只有A︰P欄的基本資料,並在此設一個執行複製的按鈕,

    然後按此執行複製按鈕後,即會自動產生7個Sheet之檔案(即需求檔),內容如需求檔說明。

    希望小弟的說明,能讓您瞭解,否則這麼晚了,對您真是感到萬分抱歉!

    2008-11-28 00:38:18 補充:

    TO︰夏日兄

    還是明天再麻煩您?這麼晚了還在給您添麻煩,深感過意不去。

    2008-11-28 01:03:45 補充:

    RE︰夏日兄

    不好意思,因為中間小弟去看醫生(重感冒),延遲回應,導致讓您忙到這麼晚,

    小弟深感抱歉,尚期多多包涵與見諒。

    晚安~

    2008-11-28 01:38:13 補充:

    TO︰夏日兄

    測試結果補充先~『範本』是OK的。

    Book1~ A︰P欄資料內容如『範本』,Q欄之後的資料內容,

    詳見1127-Q-3-需求檔案-內容說明(7個Sheet稍有其差異處)。

    http://www.FunP.Net/43671

    真是麻煩您了。謝謝您!

    2008-11-28 01:57:49 補充:

    TO︰夏日兄

    Book1如您的第一個檔案(GGG)就對了。

    是否又是小弟操作有錯誤?^^”

    2008-11-28 11:02:29 補充:

    RE︰夏日兄

    Sorry.讓您費神了。差異處只是小弟提醒您每個Sheet的$R$4之數值會不同而已。

    您的1126-n3押『按鈕1』,產生的檔案Book1其內容是與範本完全相同的7個Sheet,

    小弟要的是押『按鈕1』,產生的檔案內容是與您的意見3︰第一個檔案(GGG)相同的。

    附上Book1&(GGG)二個檔讓夏日兄比對,這樣您就應該會清楚了。謝謝您!

    http://www.FunP.Net/680115

    2008-11-28 11:30:00 補充:

    RE︰夏日兄

    原來是這樣子!小弟還以為又是我操作錯誤了。^_^

    有方法解決嗎?麻煩夏兄您了!謝謝您!

    2008-11-28 12:20:23 補充:

    RE︰夏日兄

    http://www.FunP.Net/521759

    小弟試了很多次,還是無法如願,^_^

    不過沒關係,就請人幫忙。

    也正好可以藉此討論2003&2007的差異處之解決辦法。

    2008-11-28 13:38:43 補充:

    RE︰夏日兄

    貼上補充內容才看到意見,抱歉!

    您誤解了!

    小弟說的請人是指另外開題。

    新範例檔小弟尚未下載,

    回應您最新的意見先。

    2008-11-28 13:45:14 補充:

    RE︰夏日兄

    效果如上一個檔相同。^_^

    辛苦您了!真是謝謝您!

    小弟已另外開題討論2003與2007版本解決之道;

    倘若您不介意的話,

    懇請參予討論。

Still have questions? Get your answers by asking now.