- 帖子
- 582
- 主題
- 75
- 精華
- 0
- 積分
- 682
- 點名
- 0
- 作業系統
- win7
- 軟體版本
- office 2010
- 閱讀權限
- 50
- 性別
- 男
- 註冊時間
- 2012-10-30
- 最後登錄
- 2026-4-13
|
回復 28# GBKEE - Sub Ex()
- Dim Sh As Worksheet, Rng As Range, C As Range, Ar()
- Dim R As Range, E As Range
- With Sheets("State") '*** 須改為: Test.xlsm的State Sheet
- Set R = .Cells(1, "a") 'A1開始
-
- fs = "C:\Documents and Settings\USER\桌面\DOCS RECEIVED N RELEASED RECORD.xlsx"
- With Workbooks.Open(fs)
- Set Sh = .Sheets("收件記錄")
- Do Until R = "" '離開迴圈的條件: A欄的 儲存格=""
- With Sh '*** 須改為: W:\Payment Daily Report\DOCS RECEIVED N RELEASED RECORD.xlsx"
-
- Set Rng = .Columns("D").Find(R, lookat:=xlWhole)
- If Not Rng Is Nothing Then
- With .Columns("D")
- .Replace R, "=ABC", xlWhole '修改"尋找的字串" = 沒定義的名稱
- Set Rng = .SpecialCells(xlCellTypeFormulas, xlErrors) '儲存格有錯誤值的特定範圍
- Rng.Value = R '沒定義的名稱 改回 "尋找的字串"
- For Each E In Rng.Offset(0, 4) 'D欄位移4欄=H欄
- If InStr(UCase(E), "OBL") Then 'H欄的字元內包含"OBL"三個字
- 'UCase(E) 轉換為大寫
- R.Offset(0, 9) = E.Value 'R.Offset(0, 9)-> A欄位移到 J欄
- 'Test.xlsm的State Sheet->J欄=DOCS RECEIVED N RELEASED RECORD.xlsx"->H欄的字元
- Exit For '有找到 "OBL" 離開迴圈 '
- End If
- Next
- End With '.Columns("D")
- End If
- End With 'Sheet2
- Set R = R.Offset(1) '下移到 A2
- Loop
- End With 'Sheet1
- End With
- End Sub
複製代碼 這樣就可以了。
不過這個程式,如果DOCS RECEIVED N RELEASED RECORD.xlsx的H欄幾列是合併的話,就讀不了只有第一個才會有資料,第二列開始就無資料。 |
|