- 帖子
- 5923
- 主題
- 13
- 精華
- 1
- 積分
- 5986
- 點名
- 0
- 作業系統
- win10
- 軟體版本
- Office 2010
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台灣基隆
- 註冊時間
- 2010-5-1
- 最後登錄
- 2022-1-23
        
|
2#
發表於 2013-5-21 16:39
| 只看該作者
本帖最後由 GBKEE 於 2013-5-21 16:42 編輯
回復 1# eg0802
[JZT BC-總表] 請先建立一工作表(範本 :115602的表格) 多餘的工作表可刪除掉- Option Explicit
- Dim WB(1 To 2) As Workbook
- Sub EX()
- Dim R(1 To 2) As Range
- Set WB(1) = Workbooks("總訂單數量.xls")
- Set WB(2) = Workbooks("JZT BC-總表.xls")
- With WB(1).Sheets(1)
- Set R(1) = .Range("B3", .[B3].End(xlDown))
- R(1).AdvancedFilter xlFilterCopy, , .Cells(1, .Rows.Columns.Count), True
- Set R(2) = .Cells(2, .Rows.Columns.Count)
- Do While R(2) <> ""
- With R(1)
- .Replace R(2), "=AAA", xlWhole
- With .SpecialCells(xlCellTypeFormulas, xlErrors)
- .Name = "WS"
- .Value = R(2)
- End With
- End With
- 資料匯入 R(2).Value, Range("WS")
- Set R(2) = R(2).Offset(1)
- Loop
- End With
- WB(2).Save
- End Sub
- Private Sub 資料匯入(Sh_Name As String, Rng As Range)
- Dim R As Integer
- On Error GoTo L
- R = Rng.Columns(10).Rows.Count
- With WB(2).Sheets(Sh_Name) '工作表不存在會有錯
- .[B24] = Rng.Cells(1, 9)
- .[I6] = Sh_Name
- With .[A30:G60]
- .Cells = ""
- .Cells(1, "A").Resize(R, 1) = Rng.Columns(11).Value
- .Cells(1, "B").Resize(R, 1) = Rng.Columns(3).Value
- .Cells(1, "C").Resize(R, 1) = Rng.Columns(6).Value
- .Cells(1, "E").Resize(R, 1) = Rng.Columns(4).Value
- .Cells(1, "F").Resize(R, 1) = Rng.Columns(5).Value
- End With
- End With
- Exit Sub
- L:
- With Workbooks("JZT BC-總表.xls")
- .Sheets("範本").Copy , .Sheets(1)
- ActiveSheet.Name = Sh_Name
- End With
- Resume
- End Sub
|
|
發表於 2013-5-21 14:06
| 
