1234
返回列表 上一主題 發帖

[發問] 請問VBA 的程式有沒有可以辨認某個儲存格內的字元有無包含某幾個字串？

Hsieh

帖子
4901 
主題
44 
精華
24 
積分
4916 
點名
267  
作業系統
Windows 7 
軟體版本
Office 20xx 
閱讀權限
150 
性別
男 
來自
台北 
註冊時間
2010-4-30 
最後登錄
2025-10-31 

2024年全勤獎章2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
21# 跳轉到 »
發表於 2013-3-9 23:04 | 只看該作者
回復 19# 198188

如果我寫這句替代上面兩句fs = "W:\PIHK\DOCS RECEIVED N RELEASED RECORD.xlsx"
第5行這句
With Workbooks.Open(fd & fs)
就要改成
With Workbooks.Open(fs)

Join(Ar, "、"): Erase 這句是什麼意思？
程式語法不能只讀一半，在同一行敘述使用冒號，相當於兩行敘述
Join(Ar, "、") →  會得到陣列元素用頓號、連接的字串
Erase Ar →  是清空陣列

程式寫得對不對，執行一下就知道結果啦
學海無涯_不恥下問

TOP

198188

帖子
514 
主題
71 
精華
0 
積分
610 
點名
1  
作業系統
win7 
軟體版本
office 2010 
閱讀權限
50 
性別
男 
註冊時間
2012-10-30 
最後登錄
2025-10-31 
22#
發表於 2013-3-9 23:15 | 只看該作者
回復 21# Hsieh


        感謝解釋，雖然不太明白，但會多嘗試。
另外我想問
如果H 欄如附件那樣合併，是否無法讀取？
只有214110 有資料
下面幾個是不是等於空格沒資料？
210695
214162
213924
212340
212341
211914
211915
212857

TOP

Hsieh

帖子
4901 
主題
44 
精華
24 
積分
4916 
點名
267  
作業系統
Windows 7 
軟體版本
Office 20xx 
閱讀權限
150 
性別
男 
來自
台北 
註冊時間
2010-4-30 
最後登錄
2025-10-31 

2024年全勤獎章2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
23#
發表於 2013-3-9 23:29 | 只看該作者
本帖最後由 Hsieh 於 2013-3-10 10:14 編輯

回復 22# 198188
這樣的程式與樓上程式碼比較看看應該就容易了解
  1. Sub ex()
  2. Dim Sh As Worksheet, Rng As Range, C As Range, Ar()
  3. fd = ThisWorkbook.Path & "\"  '資料來源目錄
  4. fs = "DOCS RECEIVED N RELEASED RECORD.xlsx" '資料來源檔案(含副檔名)
  5. With Workbooks.Open(fd & fs)
  6.   Set Sh = .Sheets("收件記錄")
  7.       With ThisWorkbook.Sheets("State")
  8.          For Each A In .Range(.[A2], .Cells(.Rows.Count, 1).End(xlUp))
  9.             Set Rng = Sh.Columns("D").Find(A, lookat:=xlWhole)
  10.             If Not Rng Is Nothing Then
  11.                For Each C In Sh.Range(Rng, Sh.Cells(Sh.Rows.Count, 4).End(xlUp))
  12.                   If C = A And InStr(UCase(C.Offset(, 4).MergeArea(1)), "OBL") > 0 Then
  13.                      ReDim Preserve Ar(s)
  14.                      Ar(s) = C.Offset(, 4).MergeArea(1)
  15.                      s = s + 1
  16.                   End If
  17.                 Next
  18.             If s > 0 And A.Offset(, 9) = "" Then
  19.                A.Offset(, 9) = Join(Ar, "、")
  20.                Erase Ar
  21.                s = 0
  22.                   Else
  23.                A.Offset(, 9) = ""
  24.             End If
  25.             End If
  26.          Next
  27.       End With
  28.     .Close
  29. End With
  30. End Sub
複製代碼
學海無涯_不恥下問

TOP

198188

帖子
514 
主題
71 
精華
0 
積分
610 
點名
1  
作業系統
win7 
軟體版本
office 2010 
閱讀權限
50 
性別
男 
註冊時間
2012-10-30 
最後登錄
2025-10-31 
24#
發表於 2013-3-10 00:17 | 只看該作者
回復 23# Hsieh


    原理明白，只是語法用法末清晰如何用，謝！
如果合併幾個儲存格是否讀不了？如上圖？

TOP

Hsieh

帖子
4901 
主題
44 
精華
24 
積分
4916 
點名
267  
作業系統
Windows 7 
軟體版本
Office 20xx 
閱讀權限
150 
性別
男 
來自
台北 
註冊時間
2010-4-30 
最後登錄
2025-10-31 

2024年全勤獎章2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
25#
發表於 2013-3-10 09:21 | 只看該作者
回復 24# 198188
善用F1說明與逐行偵錯才能對語法徹底了解
你問合併儲存格是否可行?
表示你根本沒有執行測試
沒有勇氣測試只會讓你永遠停頓
除非有證明樓上程式碼無法達成需求
且說明清楚問題點，否則此問題將不再回應
學海無涯_不恥下問

TOP

198188

帖子
514 
主題
71 
精華
0 
積分
610 
點名
1  
作業系統
win7 
軟體版本
office 2010 
閱讀權限
50 
性別
男 
註冊時間
2012-10-30 
最後登錄
2025-10-31 
26#
發表於 2013-3-10 10:07 | 只看該作者
回復 25# Hsieh


    合併一問，之前已試過，只有第一個可讀取，其余是空格。我問題寫得不清楚，抱歉。
應該是不是有方法做到？

TOP

Hsieh

帖子
4901 
主題
44 
精華
24 
積分
4916 
點名
267  
作業系統
Windows 7 
軟體版本
Office 20xx 
閱讀權限
150 
性別
男 
來自
台北 
註冊時間
2010-4-30 
最後登錄
2025-10-31 

2024年全勤獎章2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
27#
發表於 2013-3-10 10:18 | 只看該作者
回復 26# 198188
你怎麼測試的?
play.gif
學海無涯_不恥下問

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
28#
發表於 2013-3-10 15:16 | 只看該作者
回復 20# 198188
With Sheet2                 (這句是否改With W:\Payment Daily Report\DOCS RECEIVED N RELEASED RECORD.xlsx ？）但是好像不對？？
如果我寫這句替代上面兩句fs = "W:\PIHK\DOCS RECEIVED N RELEASED RECORD.xlsx"
第5行這句
With Workbooks.Open(fd & fs)
就要改成
With Workbooks.Open(fs)
  1.              With Workbooks.Open(fs)
  2.                      Set Sh=.Sheets("收單記錄SHEET")
  3.              End With

  5.               With Sh  '->如此 Sh 已替代為為W:\Payment Daily Report\DOCS RECEIVED N RELEASED RECORD.xlsx"的 收單記錄SHEET
  6.             
  7.                End With
複製代碼

TOP

198188

帖子
514 
主題
71 
精華
0 
積分
610 
點名
1  
作業系統
win7 
軟體版本
office 2010 
閱讀權限
50 
性別
男 
註冊時間
2012-10-30 
最後登錄
2025-10-31 
29#
發表於 2013-3-10 20:34 | 只看該作者
回復 27# Hsieh


    現在可以了，可能是excel有點衝突。
不知道為什麼有時候excel的程式本身一直沒問題，但是有時候會突然出現問題，但是重新啟動excel 後或者重新啟動電腦後，就沒有問題了。

TOP

198188

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

TOP

        靜思自在 : 好事要提得起，是非要放得下，成就別人即是成就自己。
1234
返回列表 上一主題