- 帖子
- 5923
- 主題
- 13
- 精華
- 1
- 積分
- 5986
- 點名
- 0
- 作業系統
- win10
- 軟體版本
- Office 2010
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台灣基隆
- 註冊時間
- 2010-5-1
- 最後登錄
- 2022-1-23
        
|
18#
發表於 2011-7-23 06:45
| 只看該作者
本帖最後由 GBKEE 於 2011-7-23 09:23 編輯
回復 1# ffntldj
比對A sheet 和 C sheet裡面的資料 附黨中沒有C sheet 可以更新嗎?- Sub 解答1Ex()
- Dim Rng As Range, Ar, Msg As Boolean
- Dim Word_In As String, Word_Out As String
- Word_In = "Mod part" '進入字串
- Word_Out = "ACTION" '離開字串
- Set Rng = Sheets("A").[A1] '尋找字串的起始點
- ReDim Ar(0) '重新宣告陣列的維數
- Do
- If Rng = Word_In Then Msg = True '是進入字串 邏輯值=True
- If Rng = Word_Out Then Msg = False '是離開字串 邏輯值=False
- If Msg = True And Rng <> Word_In Then '邏輯值=True 且字串不是"進入字串"
- ' Application.Match(Rng, Ar, 0) '在陣列比對不到同樣的字串 傳回錯誤值
- If IsError(Application.Match(Rng, Ar, 0)) Then '傳回錯誤值
- If Ar(UBound(Ar)) <> "" Then ReDim Preserve Ar(UBound(Ar) + 1)
- 'Preserve 保留陣列原有資料的關鍵字
- Ar(UBound(Ar)) = Rng 'UBound(Ar) 陣列的最大維數
- End If
- End If
- Set Rng = Rng.Offset(1) '設定 Rng=Rng的下一列
- Loop Until Rng = "" '離開 DO 迴圈的條件是 Until(直到) Rng = ""
- Sheets("A1").Rows(1) = "" '整列
- Sheets("A1").[A1].Resize(1, UBound(Ar) + 1) = Ar 'Resize 儲存格擴充範圍(1列, 欄位:=UBound(Ar) + 1)
- End Sub
- Sub 解答2Ex()
- Dim Rng(1 To 2) As Range, Ar, Msg As Boolean, R As Range
- Dim Word_In As String, Word_Out As String, Word_Look As String
- Word_In = "Mod part" '進入字串
- Word_Out = "ACTION" '離開字串
- Word_Look = "MODIFY"
- Set Rng(1) = Sheets("A").[A1] '尋找字串的起始點
- ReDim Ar(0) '重新宣告陣列的維數
- Do
- If UCase(Rng(1)) = UCase(Word_In) Then Msg = True '是進入字串 邏輯值=True
- If UCase(Rng(1)) = UCase(Word_Out) Then Msg = False '是離開字串 邏輯值=False
- If Msg = True And UCase(Rng(1)) <> UCase(Word_In) Then '邏輯值=True 且字串不是"進入字串"
- Set Rng(2) = Sheets("a").Columns(1).Find(Word_Look, After:=Rng(1), lookat:=xlWhole, MatchCase:=False) '尋找最接近的 "MODIFY"
- If IsError(Application.Match(Rng(1) & Rng(2).Offset(, 1), Ar, 0)) Then '比對不到 "PARTID&OPE_NO"字串 傳回錯誤值
- If Ar(UBound(Ar)) <> "" Then ReDim Preserve Ar(UBound(Ar) + 1)
- Ar(UBound(Ar)) = Rng(1) & Rng(2).Offset(, 1) 'UBound(Ar) 陣列的最大維數
- End If
- End If
- Set Rng(1) = Rng(1).Offset(1) '設定 Rng(1)=Rng(1)的下一列
- Loop Until Rng(1) = "" '離開 DO 迴圈的條件是 Until(直到) Rng(1) = ""
- Set Rng(1) = Nothing '釋放變數
- For Each R In Sheets("B").Range("a1").CurrentRegion.Rows 'R ->依序在Sheets("B")[A1延伸範圍的每一列
- If Not IsError(Application.Match(R.Cells(1) & R.Cells(2), Ar, 0)) Then '陣列中比對到SHEETS("B") A欄&B欄 的字串
- If Rng(1) Is Nothing Then Set Rng(1) = R Else Set Rng(1) = Union(Rng(1), R) '設定變數
- End If
- Next
- With Sheets("B1")
- .UsedRange.Clear '清除 Sheets("B1")的內容
- Rng(1).Copy .[A1]
- End With
- End Sub
|
|
發表於 2011-7-21 09:48
| 
