123
返回列表 上一主題 發帖

[發問] 跨欄置中與擷取文字問題

v03586

帖子
193 
主題
29 
精華
0 
積分
222 
點名
0  
作業系統
Windows7 
軟體版本
OFFICE2013 
閱讀權限
20 
註冊時間
2015-9-18 
最後登錄
2023-4-29 
13# 跳轉到 »
發表於 2016-1-14 08:42 | 只看該作者
回復 12# v03586


    Sorry....程式檔案中TBG1旁邊（右）製程欄位多加一個製程欄位PGH1
忘記加上去.....thanks

TOP

v03586

帖子
193 
主題
29 
精華
0 
積分
222 
點名
0  
作業系統
Windows7 
軟體版本
OFFICE2013 
閱讀權限
20 
註冊時間
2015-9-18 
最後登錄
2023-4-29 
12#
發表於 2016-1-14 07:47 | 只看該作者
回復 11# v03586


    補充....
STEP 裡面 只要有WGD1  /   WGH1   /   WGP1 / WGS1  / WG01
都列入WG欄位裡面..!!!  WGxx都屬於WG製程欄位

TOP

v03586

帖子
193 
主題
29 
精華
0 
積分
222 
點名
0  
作業系統
Windows7 
軟體版本
OFFICE2013 
閱讀權限
20 
註冊時間
2015-9-18 
最後登錄
2023-4-29 
11#
發表於 2016-1-14 02:51 | 只看該作者
回復 9# 准提部林


    回復 9# 准提部林


Q1.感謝大大!! 我針對程式碼修改至我自己的程式報表(FMC), 發現欄位Substrate 與 B/D Np 欄位 就是取 『-』 好像切得不是很乾淨 (W與X欄位)
還有最後一欄一長串那個, 我修改不出來...求指教....

Q2.還有可以將匯入報表模式改成 Excel 打開後比對 (參考報表資料來源:ONHAND2HR_Ist_Flow)
          A2欄位有 ON HAND--PC_ONHAND2HR_1ST_FLOW 就等同匯入報表嗎?  
      意思就是只要打開程式EXCEL 與 參考資料來源 比對資料表Sheet1 A2欄有ON HAND--PC_ONHAND2HR_1ST_FLOW 字眼

請問大大能否新增幾樣功能嗎
1. 功能1
    1-1. 如果執行時間比對參考資料來源Date Time (L欄)超過24H 能幫我反黃色標示嗎?
2. 功能2
   2-1. 程式中報表上CUSTNAME 欄位中如果有 CSP / L1 / L2 / 字串則整個刪除
   2-2. 保留 ENG / HQCSP / HQ-CSP / HQ-L1 / HQ-L2 / HQL1 / HQL2
   2-3. 然後移去ENG 移至ENG資料表, HQ CSP系列移至CSP資料表, HQ L1 / HQ L2 系列移至Other資料表
3. 功能3
    3-1. 報表參考資料中的Q欄位QTY ,能比對 P欄位 STEP 帶入
            程式中的相對欄位嗎?   (如執行結果EXCEL)
4. 功能4
   4-1. 程式中,資料表FMC,前面有看見A欄位與B欄位 已有合併儲存格, 發現後面有很多相同重複的 也可以合併嗎?
     4-1-1. S欄位(Custname)   T欄位(Device)  U欄位(Datetime) Ｖ欄位(MO QTY)  W欄位Substrate  X欄位(B/D No)  Y欄位(Flow)

檔案內說明
[2F新報表程式_v1] 上述為程式   [ONHAND2HR_Ist_Flow] 上述為參考資料來源
Report.rar (434.41 KB)

TOP

v03586

帖子
193 
主題
29 
精華
0 
積分
222 
點名
0  
作業系統
Windows7 
軟體版本
OFFICE2013 
閱讀權限
20 
註冊時間
2015-9-18 
最後登錄
2023-4-29 
10#
發表於 2016-1-14 02:29 | 只看該作者
回復 9# 准提部林


    Excel 打開比對A2欄位有 ON HAND--PC_ONHAND2HR_1ST_FLOW
就等同匯入報表嗎

TOP

准提部林

帖子
2848 
主題
10 
精華
0 
積分
2903 
點名
0  
作業系統
〔略〕 
軟體版本
〔略〕 
閱讀權限
100 
性別
男 
來自
〔略〕 
註冊時間
2013-5-13 
最後登錄
2026-7-25 
9#
發表於 2016-1-13 13:52 | 只看該作者
用最基本的程式語法, 自行去研究, 不再多說明~~
  1. Sub TEST()
  2. Dim R&, xArea As Range, xR As Range, xH As Range, T, TT, X
  3. R = [報表!A65536].End(xlUp).Row: If R < 9 Then Exit Sub
  4. Set xArea = Sheets("報表").Range("A9:A" & R)
  5. For Each xR In xArea
  6. 　　T = xR(1, 3): xR(1, 3) = Mid(T, InStr(T, "-") + 1)
  7. 　　xR(1, 4) = Right(xR(1, 4), 9)
  8.      　
  9. 　　T = xR(1, 5):  T = Left(T, 2) & "-" & Mid(T, 3, 1) & "-" & Mid(T, 4, 4)
  10. 　　TT = Application.VLookup(T, [Flow!A:B], 2, 0)
  11. 　　If Not IsError(TT) Then xR(1, 5) = TT Else xR(1, 5).Font.Color = vbRed
  12.      　
  13. 　　T = xR(1, 6)
  14. 　　T = Mid(T & ",QVS", InStr(T, "QVS") + 4) '取 QVS 以後字串
  15. 　　For Each TT In Array("SPC", "SCL")
  16. 　　　　X = InStr(T, TT): If X > 0 Then xR(1, 6) = Left(T, X + 2): Exit For
  17. 　　Next
  18. Next
  19. 　
  20. xArea.Resize(, 6).Sort Key1:=xArea(1, 1), Order1:=xlAscending, _
  21.                        Key2:=xArea(1, 4), Order2:=xlAscending, Header:=xlNo
  22.                       　
  23. Application.DisplayAlerts = False
  24. For Each xR In xArea
  25. 　　If xR & xR(1, 2) <> xR(0) & xR(0, 2) Then Set xH = xR
  26. 　　If xR & xR(1, 2) <> xR(2) & xR(2, 2) Then
  27. 　　　Range(xH, xR).Merge: Range(xH(1, 2), xR(1, 2)).Merge
  28. 　　　Range(xH, xR(1, 6)).Borders.LineStyle = 1
  29. 　　　For i = 7 To 10
  30. 　　　　　Range(xH, xR(1, 6)).Borders(i).Weight = xlMedium
  31. 　　　Next i
  32. 　　End If
  33. Next
  34. End Sub
複製代碼

TOP

stillfish00

帖子
1018 
主題
15 
精華
0 
積分
1058 
點名
0  
作業系統
win7 32bit 
軟體版本
Office 2016 64-bit 
閱讀權限
50 
性別
男 
來自
桃園 
註冊時間
2012-5-9 
最後登錄
2022-9-28 
8#
發表於 2016-1-13 09:57 | 只看該作者
回復 7# v03586
  1. oRegexp : regular expression 正則表達式/正規表示法，用來查找、替換、提取、驗證字串，
  2. ，可參考 http://club.excelhome.net/thread-1128647-1-2.html 學習

  4. .Pattern = "^[^-]*-" 用來設定規則
  5. ^ : 字串開頭位置
  6. [^-] : 非-的任意字元
  7. [^-]* : 0~n個非-的任意字元
  8. - : -字元
  9. 所以是匹配開頭到第一個-字元

  11. .Test 是用來測試是否符合規則
  12. .Replace 是把符合規則部分的字串取代掉
複製代碼
表達不清、題意不明確、沒附檔案格式、沒有討論問題的態度~~~~~~以上愛莫能助。

TOP

v03586

帖子
193 
主題
29 
精華
0 
積分
222 
點名
0  
作業系統
Windows7 
軟體版本
OFFICE2013 
閱讀權限
20 
註冊時間
2015-9-18 
最後登錄
2023-4-29 
7#
發表於 2016-1-12 23:40 | 只看該作者
回復 6# stillfish00


    感謝大大的幫忙!!!
但我部分看不太清楚 , 可否麻煩大大針對幾項功能協助做個說明

EX :
  1.    With oRegexp
  2.         .Pattern = "^[^-]*-"
  3.         For i = 1 To UBound(ar)
  4.             If .Test(ar(i, 3)) Then ar(i, 3) = .Replace(ar(i, 3), "")
  5.         Next
  6.         .Pattern = "^[^-]*-[^-]*-"
複製代碼
這一段是判斷什麼功能?
  1.         For i = 1 To UBound(ar)
  2.             If .Test(ar(i, 4)) Then ar(i, 4) = .Replace(ar(i, 4), "")
  3.         Next
  4.         .Pattern = "^(.{2})(.)(.*)[a-zA-Z]$"
複製代碼
這一段是判斷什麼功能
我不知道這樣切 有沒有切錯段落

TOP

stillfish00

帖子
1018 
主題
15 
精華
0 
積分
1058 
點名
0  
作業系統
win7 32bit 
軟體版本
Office 2016 64-bit 
閱讀權限
50 
性別
男 
來自
桃園 
註冊時間
2012-5-9 
最後登錄
2022-9-28 
6#
發表於 2016-1-12 15:04 | 只看該作者
回復 4# v03586
Try this
4.依照D欄相同的字串用黑框線  => 改為依合併的A欄畫粗框
  1. Sub Test()
  2.     Dim oRegexp As Object: Set oRegexp = CreateObject("vbscript.regexp")
  3.     Dim ar, i, j, s
  4.    
  5.     ar = Sheets("報表").Range("A9:F21").Value  'or .Range("A9").CurrentRegion.Value
  6.    
  7.     With oRegexp
  8.         .Pattern = "^[^-]*-"
  9.         For i = 1 To UBound(ar)
  10.             If .Test(ar(i, 3)) Then ar(i, 3) = .Replace(ar(i, 3), "")
  11.         Next
  12.         .Pattern = "^[^-]*-[^-]*-"
  13.         For i = 1 To UBound(ar)
  14.             If .Test(ar(i, 4)) Then ar(i, 4) = .Replace(ar(i, 4), "")
  15.         Next
  16.         .Pattern = "^(.{2})(.)(.*)[a-zA-Z]$"
  17.         For i = 1 To UBound(ar)
  18.             If .Test(ar(i, 5)) Then
  19.                 s = .Replace(ar(i, 5), "$1-$2-$3")
  20.                 mch = Application.VLookup(s, Sheets("Flow").[A:B], 2, False)
  21.                 If Not IsError(mch) Then ar(i, 5) = mch
  22.             End If
  23.         Next
  24.         .Pattern = "(SPC|SCL).*$"
  25.         '另一種 QVS to SPC/SCL
  26.         '.Pattern = "^.*?(QVS.*?(SPC|SCL)).*$"
  27.         For i = 1 To UBound(ar)
  28.             If .Test(ar(i, 6)) Then ar(i, 6) = .Replace(ar(i, 6), "$1")
  29.         Next
  30.         
  31.     End With
  32.    
  33.     Application.ScreenUpdating = False
  34.     With Sheets.Add.[A1].Resize(UBound(ar), UBound(ar, 2))
  35.         .Value = ar
  36.         .Sort key1:=.Cells(1, 1), order1:=xlAscending, key2:=.Cells(1, 4), order2:=xlAscending
  37.         .Borders.LineStyle = xlContinuous
  38.         .Borders.Weight = xlThin
  39.         Application.DisplayAlerts = False
  40.         i = 1
  41.         For j = 1 To UBound(ar)
  42.             If .Cells(j, 2).Value <> .Cells(j + 1, 2).Value Then
  43.                 If i <> j Then Range(.Cells(i, 1), .Cells(j, 1)).Merge
  44.                 With .Cells(i, 1).MergeArea.Resize(, .Columns.Count)
  45.                     .Borders(xlEdgeTop).Weight = xlMedium
  46.                     .Borders(xlEdgeBottom).Weight = xlMedium
  47.                     .Borders(xlEdgeLeft).Weight = xlMedium
  48.                     .Borders(xlEdgeRight).Weight = xlMedium
  49.                 End With
  50.                 i = j + 1
  51.             End If
  52.         Next
  53.         Application.DisplayAlerts = True
  54.         
  55.         [B:B].Font.Size = 16
  56.         [C:D].Font.Size = 12
  57.         ActiveWindow.Zoom = 63
  58.         [A:F].EntireColumn.AutoFit
  59.         [A:B].HorizontalAlignment = xlCenter
  60.     End With
  61.     Application.ScreenUpdating = True
  62. End Sub
複製代碼
表達不清、題意不明確、沒附檔案格式、沒有討論問題的態度~~~~~~以上愛莫能助。

TOP

v03586

帖子
193 
主題
29 
精華
0 
積分
222 
點名
0  
作業系統
Windows7 
軟體版本
OFFICE2013 
閱讀權限
20 
註冊時間
2015-9-18 
最後登錄
2023-4-29 
5#
發表於 2016-1-11 20:24 | 只看該作者
回復 3# hcm19522


    大大果然是函數達人!!!!  因處理資料上千筆, 所以必須寫入迴圈
我覺得大大這個方法也很好!!!值得參考

TOP

v03586

帖子
193 
主題
29 
精華
0 
積分
222 
點名
0  
作業系統
Windows7 
軟體版本
OFFICE2013 
閱讀權限
20 
註冊時間
2015-9-18 
最後登錄
2023-4-29 
4#
發表於 2016-1-11 20:20 | 只看該作者
Sorry , 補檔案
test.rar (87.5 KB)

TOP

        靜思自在 : 能幹不幹，不如苦幹實幹。
123
返回列表 上一主題