帖子: 72
主題: 13
精華: 0
積分: 90
點名: 0
作業系統: windows xp
軟體版本: office 2000
閱讀權限: 20
性別: 女
註冊時間: 2011-2-14
最後登錄: 2024-10-13

1^# 跳轉到 » 倒序看帖

字體大小: tT

發表於 2011-5-7 05:13 | 只看該作者

[發問] 比對和標示內容

目的:mapping.xls巨集程式自動讀取source.xls判斷末三碼,
符合者make為黃色.

如 :mapping.xls 開啟巨集程式自動讀取source.xls判斷末三碼,
符合者make為黃色.

1. 先讀取source.xls A欄位所有的值,如讀取 2231-50、2234-43...
2. 再將mapping.xls 裡的 1-50、4-43 mark 成黃色
3. 附件

new_mapping.rar (8.29 KB)

樓主熱帖

et5323

尊貴會員 Rank: 5 Rank: 5

帖子: 128
主題: 13
精華: 1
積分: 118
點名: 0
作業系統: WinXP
軟體版本: Office2003
閱讀權限: 50
性別: 男
來自: 四川成都邛崃
註冊時間: 2010-9-13
最後登錄: 2017-5-12

2^#

發表於 2011-5-7 17:51 | 只看該作者

Sub myColor(xlSht As Worksheet)
Dim oDic As Object, xlWk As Object
Dim arr, i, r As Range
Application.ScreenUpdating = False
Set xlWk = GetObject(ThisWorkbook.Path & "\source.xls")
With xlWk
      With .Sheets(xlSht.Name)
         arr = .Range("a1:a" & .[a65536].End(xlUp).Row)
      End With
      .Close False
End With

Set oDic = CreateObject("scripting.dictionary")
For i = 1 To UBound(arr)
      oDic(Right(arr(i, 1), 4)) = ""
Next
xlSht.UsedRange.Interior.ColorIndex = xlNone
For Each r In xlSht.UsedRange
      With r
         If oDic.exists(.Value) Then .Interior.Color = RGB(255, 255, 0)
      End With
Next
Application.ScreenUpdating = True
End Sub

Sub test()
myColor Sheets("2.2")
'myColor Sheets("3.0")
End Sub

公社是棵長青藤,社員都是藤上的瓜.

TOP

Hsieh

超級版主 Rank: 8 Rank: 8

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

2023年全勤獎章 2022虎年全勤獎章 2021牛年全勤獎章 2020鼠年全勤獎章 2019 豬年全勤獎章 2018 狗年全勤獎章 2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱心公益勳章 2011兔年全勤獎章

3^#

發表於 2011-5-7 18:33 | 只看該作者

Private Sub Workbook_Open()
Dim sh, fs$, s As Worksheet, mystr$, a(), C As Range
Set d = CreateObject("Scripting.Dictionary")
fs = ThisWorkbook.Path & "\source.xls" 'source.xls目錄與mapping.xls相同
sh = Array("2.2", "3.0")
With Workbooks.Open(fs)
For Each s In .Sheets(sh)
With s
a = .Range(.[A1], .[A65536].End(xlUp))
For i = 1 To UBound(a)
mystr = .Name & Right(a(i, 1), 4)
d(mystr) = d.Count
Next
End With
Next
.Close
End With
With Me
For Each s In .Sheets(sh)
s.UsedRange.Interior.ColorIndex = -4142
For Each C In s.UsedRange
If d.exists(s.Name & C) Then C.Interior.ColorIndex = 6
Next
Next
End With
End Sub

複製代碼

學海無涯_不恥下問

TOP

GBKEE

超級版主 Rank: 8 Rank: 8

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

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

4^#

發表於 2011-5-7 19:46 | 只看該作者

本帖最後由 GBKEE 於 2011-5-7 19:52 編輯

原先看不懂樓主的意思依樣畫葫蘆改用 Application.Match 比對

Sub Ex()
Dim Fs$, Sh As Worksheet, R As Range, AR()
Fs = ThisWorkbook.Path & "\source.xls"
ReDim AR(0)
With Workbooks.Open(Fs)
For Each Sh In .Sheets
For Each R In Sh.UsedRange
If IsError(Application.Match(Right(R, 4), AR, 0)) And R <> "" Then
AR(UBound(AR)) = Right(R, 4)
ReDim Preserve AR(UBound(AR) + 1)
End If
Next
Next
.Close 0
End With
With Me
For Each Sh In .Sheets
Sh.UsedRange.Interior.ColorIndex = -4142
For Each R In Sh.UsedRange
If IsError(Application.Match(Right(R, 4), AR, 0)) = False And R <> "" Then
R.Interior.ColorIndex = 6
End If
Next
Next
End With
End Sub

複製代碼

TOP

jackyliu

中學生 Rank: 2

帖子: 72
主題: 13
精華: 0
積分: 90
點名: 0
作業系統: windows xp
軟體版本: office 2000
閱讀權限: 20
性別: 女
註冊時間: 2011-2-14
最後登錄: 2024-10-13

5^#

發表於 2011-5-9 20:55 | 只看該作者

感謝大大幫忙...
可以幫忙解惑一下好嗎?

Dim sh, fs$, s As Worksheet, mystr$, a(), C As Range
sh 有宣告什麼型態嗎?和fs$ 有關係嗎?後面還有一個a(),這是宣告哪裡?

sh = Array("2.2", "3.0") 這裡的Array 是只陣列嗎?

TOP

Hsieh

超級版主 Rank: 8 Rank: 8

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

2023年全勤獎章 2022虎年全勤獎章 2021牛年全勤獎章 2020鼠年全勤獎章 2019 豬年全勤獎章 2018 狗年全勤獎章 2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱心公益勳章 2011兔年全勤獎章

6^#

發表於 2011-5-9 21:32 | 只看該作者

fs$是將變數宣告為字串型態，這裡是用來當作source.xls的完整目錄字串
sh沒有宣告任何型態，所以被默認宣告為Variant
正確寫法應為Dim sh As Variant
而sh = Array("2.2", "3.0")
就指定sh的內容為一維陣列，其內容是2個數值型的字串，此處就是你的來源檔案要比對的2個工作表名稱
a()就是宣告一個陣列變數a，此陣列內容
a = .Range(.[A1], .[A65536].End(xlUp))
就是source.xls的sheets("2.2")及sheets("3.0")工作表內A欄的資料範圍的值

學海無涯_不恥下問

TOP

jackyliu