暱稱: 隨風飄蕩的羽毛 頭銜: [御用]潛水艇
高中生 
- 帖子
- 852
- 主題
- 79
- 精華
- 0
- 積分
- 918
- 點名
- 0
- 作業系統
- Windows 7 , XP
- 軟體版本
- Office 2007, Office 2003,Office 2010,YoZo Office
- 閱讀權限
- 50
- 性別
- 男
- 來自
- 宇宙
- 註冊時間
- 2011-4-8
- 最後登錄
- 2024-2-21
|
回復 1# jesscc
剛剛才看到此文章...
稍微看了一下附檔.. 在 模組的 t20110308a01 的內容那邊 就已經有說明檔案..
以下是擷取該內容
'＜如何在 EXCEL 中以 "模糊比對" 取得相對應的資料＞
'－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
'■比對來源資料雖有其統一及獨立性質，但要被比對的資料呈現不規則形態，
'版大 希望用類似 LIKE 的方式比對 B LIKE A，
'但又 不想用 VBA 來使用回圈逐個判斷，避免花費時間過長，
'是因為這問題不適用 LIKE 來處理，若依此模式，必先取出一來源值，再迴圈
'逐一判斷被比對值，亦即如果來源值有 100 個，被比對值有 1,000 個，則須
'迴圈 100*1,000 次，當然失其效益。
'■還好，有 EXCEL 的〔取代〕功能可使用，能有效地處理這問題，其方法為：
'將全部〔被比對值〕複製至其〔相對位置〕的輔助欄中，再逐一以〔來源值〕
'比對，取代為欲取得的〔對應值〕，完成後將輔助欄的結果代入目的區塊中。
'此方式，僅用到來源值的迴圈 100 次，絕對比公式來得快多了。
'■然而既是〔模糊比對〕加〔取代〕，準確率難保百分百，在字串取代的順序
'上要以較多字的先取代 , 例如:
'應先取代〔中華電通〕，再取代〔中華電〕，再取代〔中華〕〔華電〕。
'■比對〔來源值〕不可與要取得的結果〔對應值〕有相同字元，以免雙重取代。
'－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
不曉得樓主要的是怎樣的效果
光把別人的檔案丟上來然後說要改 也沒說要改什麼結果
說真的 很難讓人幫您 就像上面大大們說的
相同效果(結局) 就有不同方式可以去做解決
就好比 從台北要到屏東 就有好幾種方法可以選擇 (海 陸 空)
如果 選 海 那 又有分 快 慢
如果 選 陸 又有分 縣道 省道 或 高速
以下是稍微更動的程式(含更動的些許說明)
在模組的 T20110308a01 程式下
Dim MyBook As Workbook, ShtA As Worksheet, ShtB As Worksheet, HeadA As Range, HeadB As Range, _
RowsA As Long, RowsB As Long, bClmn(1 To 4) As Range, Ax(1 To 2), i, j 'bclmn(1 to N) N= sheet1 的 數量表示 如 取消= 4
Sub 共用參照()
Set MyBook = ThisWorkbook
Set ShtA = MyBook.Sheets("Sheet1")
Set HeadA = ShtA.Range("A1")
With HeadA: RowsA = .Cells(65536 - .Row + 1, 1).End(xlUp).Row - .Row: End With
'-----------------------------------
Set ShtB = MyBook.Sheets("Sheet2")
Set HeadB = ShtB.Range("A1")
With HeadB: RowsB = .Cells(65536 - .Row + 1, 1).End(xlUp).Row - .Row: End With
End Sub
Sub 匯入()
Call 共用參照
If RowsA <= 0 Then MsgBox "※匯入來源無項目資料! ", 0 + 16: Exit Sub
If RowsB <= 0 Then MsgBox "※匯入目標無項目資料! ", 0 + 16: Exit Sub
Application.ScreenUpdating = False
'-----------------------------------------
Set bClmn(1) = Range(HeadB.Cells(2, 1), HeadB.Cells(RowsB + 1, 1))
Set bClmn(2) = Range(HeadB.Cells(2, 2), HeadB.Cells(RowsB + 1, 2))
Set bClmn(3) = Range(HeadB.Cells(2, 30), HeadB.Cells(RowsB + 1, 30))
Set bClmn(4) = Range(HeadB.Cells(2, 30), HeadB.Cells(RowsB + 1, 30)) 'set bclmn(N) N= sheet1 的 數量表示 如 取消= 4 如欲增加該數量表示 則必須新增1列
'-------------------------------------------
bClmn(3).Value = bClmn(1).Value
bClmn(2).FormulaR1C1 = "=IF(RC[28]=RC[-1],"""",RC[28])"
For i = 2 To RowsA + 1
Ax(1) = HeadA.Cells(i, 1).Value
Ax(2) = HeadA.Cells(i, 2).Value
If Ax(1) <> "" And Ax(2) <> "" Then
bClmn(3).Replace "*" & Ax(1) & "*", Ax(2), Lookat:=xlPart
End If
Next i
'-----------------------------------------
bClmn(2).Value = bClmn(2).Value
bClmn(3).ClearContents
Beep
End Sub |
|
發表於 2011-5-9 10:35
| 
