[發問] 問題請教

本帖最後由 GBKEE 於 2013-7-24 11:18 編輯

各位神大
附件有一Kohl's_APT.9 - 2013 - 0424檔案 , 裡面有許多工作表(款式名稱)
小弟想整理成如總表的樣子(只擷取各個sty 主料成本/副料成本/cmp)，請問各位大大有辦法嗎?

s_APT.9 - 2013 - 0424.rar (485.88 KB)

Jason

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

2^#

發表於 2013-7-24 12:46 | 只看該作者

回復 1# eg0802
試試看

Option Explicit
Sub EX()
Dim Sh As Worksheet, Ar(), i As Integer, ii As Integer, A(3)
ReDim Preserve Ar(i)
Ar(i) = Array("品項", "TOTAL MATERIALS COST", "TOTAL TRIM COST", "CMP") '要整理的項目
For Each Sh In ThisWorkbook.Sheets '物件: 這活頁簿中工作表的集合
If Sh.Name <> "總表" Then
With Sh
A(0) = Sh.Name '指定元素的值
For ii = 1 To 3
'A(ii) = .Cells.Find(Ar(0)(ii), LookAt:=xlWhole).Row
'*** 正常要 xlWhole(字串完全相等) -> 才會找到正確的儲存格 ****
'****這裡代入xlParte(部分字串相等) ,因工作中的"CMP" 為 " CMP " ****
A(ii) = .Cells.Find(Ar(0)(ii), LookAt:=xlPart).Row '找到字串的列號
A(ii) = .Range("G" & A(ii)) '指定元素的值: G欗&字串的列號
Next
i = i + 1
ReDim Preserve Ar(i) '重新配置陣列元素的維數(Preserve 保留舊有的元素)
Ar(i) = A
End With
End If
Next
With Sheets("總表")
.Activate
.Cells.Clear
.[A1].Resize(i + 1, UBound(A) + 1) = Application.Transpose(Application.Transpose(Ar))
End With
End Sub

複製代碼

感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限, 一天1元的贊助,人人有能力.

3^#

發表於 2013-7-25 22:09 | 只看該作者

回復 2# GBKEE

感謝G大可以用 ^^ Orz

Jason