- 帖子
- 552
- 主題
- 3
- 精華
- 0
- 積分
- 578
- 點名
- 0
- 作業系統
- win7
- 軟體版本
- office 2010
- 閱讀權限
- 50
- 性別
- 男
- 註冊時間
- 2015-2-8
- 最後登錄
- 2024-7-9
  
|
回復 20# mark761222
在匯出資料在中的工作表名稱和目的的工作表名稱有誤，可能是因為空格的關係，請自行修正否則會有
的錯誤產生- Sub 按鈕1_Click()
- Application.ScreenUpdating = False
- Dim d As Object
- Dim xlPath As Variant, xlFile As Variant, aa As Variant
- Dim Rng As Range, Rn As Range, Ran As Range, ch As Range
- Dim myRow As Integer, myCol As Integer, k As Integer, I As Integer, j As Integer, xlRow As Integer
- xlPath = ThisWorkbook.Path & "\"
- Set d = CreateObject("scripting.dictionary") '設定d為字典物件
- With Sheets("匯出資料")
- For Each Rng In .Range("A3", Cells(Rows.Count, 1).End(xlUp)) '此迴圈是讀取檔案名稱
- If Rng <> "" Then
- d(Rng.Value) = ""
- End If
- Next
- myRow = .Cells(Rows.Count, 1).End(xlUp).Row '查詢"匯出資料"的最後一列位置
- For Each Rng In .Range("B2", .Cells(myRow, 2)) '此迴圈做 有資料Range位置的聯集 Union，讀取工作表名稱
- If Rng <> "" Then
- k = k + 1
- If k = 1 Then
- Set Rn = Rng
- Else
- Set Rn = Union(Rn, Rng)
- End If
- End If
- Next
- End With
- xlFile = d.keys '將字典的key值給予xlFile(為陣列)，以目前讀取的檔案名稱有"Daily Yield Rate report 分廠 2015BR"
- '以及"Daily Yield Rate report(EN)2015BR4"2個檔案
-
- For I = 0 To UBound(xlFile) '以檔案為做為迴圈，來開啟檔案
- With Workbooks.Open(xlPath & xlFile(I) & ".xlsx") '開啟檔案
- For Each Ran In Rn '執行工作表迴圈
- If Ran.Offset(, -1) Like xlFile(I) Then '比對此工作表是否屬於xlFile(I)檔案，如果是則執行If中程序
- With .Sheets(Ran.Value)
- Set ch = .Columns(1).Find(Ran.Offset(, 1), LookAt:=xlWhole, SearchDirection:=2)
- '檢查日期是否有重複，當ch變數為Nothing時，則無發現重複日期，否則離開這一次的資料儲存，並執行下一個迴圈
- If Not ch Is Nothing Then MsgBox Ran & "工作表中的" & ch & "資料已存在，不會儲存資料": Set ch = Nothing: GoTo 10
- myCol = ThisWorkbook.Sheets("匯出資料").Cells(Ran.Row, Columns.Count).End(xlToLeft).Column
- xlRow = .Cells(Rows.Count, 1).End(xlUp).Row + 1 '讀取目的工作表的最後一列列號
- For j = 1 To myCol - 2
- If Ran.Offset(, j).Interior.Color <> 65535 Then '當儲存格色彩不屬於黃色，則執行複製值
- .Cells(xlRow, j) = Ran.Offset(, j).Value '複製值
- End If
- Next
- 10:
- End With
- End If
- Next '完成一個工作表後執行下一個工作表
- .Close True '關閉及儲存檔案
- End With
- Next
- Application.ScreenUpdating = False
- End Sub
|
|
發表於 2015-11-13 09:13
| 
