返回列表 上一主題 發帖

[發問] 相同資料之特定欄位第二筆資料用他值取代

b9208

帖子
182 
主題
34 
精華
0 
積分
316 
點名
0  
作業系統
Win 7 
軟體版本
Office 2010 
閱讀權限
20 
性別
男 
來自
Taiwan 
註冊時間
2010-5-2 
最後登錄
2023-6-24 
1# 跳轉到 » 正序看帖
打印
tT
發表於 2013-4-14 15:25 | 只看該作者

[發問] 相同資料之特定欄位第二筆資料用他值取代

先進您好
資料排序後，幾個特定欄位之資料相同者，只保留固定欄位第一筆資料，第二筆以後用0值取代。
將固定欄位等於0者，整列填滿黃色。
如附檔內說明
謝謝指導

B1.rar (8.73 KB)
收藏 分享
100 字節以內
不支持自定義 Discuz! 代碼

GBKEE

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

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
5#
發表於 2013-4-15 17:20 | 只看該作者
回復 3# b9208
不明白的函數,方法,屬性,可在程式碼中用滑鼠選取後,按F1查看說明
回復 4# b9208
程式碼須修改如下
  1. Option Explicit
  2. Sub Ex()
  3.     Dim DataBase As Range, I As Integer, D As Object, D_Item As Variant
  4.     Dim W As String
  5.     Set D = CreateObject("SCRIPTING.DICTIONARY")                            '字典物件
  6.     With Sheets("工作表1")
  7.         Set DataBase = .Range("A5").Resize(.[B5].End(xlDown).Row - 4, 9)    '制定範圍
  8.     End With
  9.     With DataBase
  10.         .Sort Key1:=.Cells(1, 2), Order1:=xlAscending, Key2:=.Cells(1, 3), Order2:=xlAscending, Key3:=.Cells(1, 4), Order3:=xlAscending, Header:=xlYes
  11.         '2003 排序只有3個排序欄位 :星期,料號,單位
  12.         .Sort Key1:=.Cells(1, 2), Order1:=xlAscending, Key2:=.Cells(1, 3), Order2:=xlAscending, Key3:=.Cells(1, 6), Order3:=xlAscending, Header:=xlYes
  13.         '再次排序:星期,料號,姓名
  14.         For I = 1 To .Rows.Count
  15.             With .Rows(I)
  16.                 W = .Cells(2) & .Cells(3) & .Cells(4) & .Cells(6) '「星期+料號+單位+姓名」四欄位資料
  17.             End With
  18.             If Not D.Exists(W) Then
  19.                 'Exists 方法 如果在 Dictionary 物件中指定的關鍵字存在，傳回 True，若不存在，傳回 False。
  20.                 '語法  Object.Exists (key)
  21.                 Set D(W) = .Rows(I)                 ''字典物件的內容: 為Range
  22.             Else
  23.                 Set D(W) = Union(D(W), .Rows(I))    'Union 方法 傳回兩個或多個範圍的合併範圍。
  24.             End If
  25.         Next
  26.         For Each D_Item In D.ITEMS                     '依序傳回 字典物件的內容
  27.             With D_Item                                '字典物件的內容: 為Range
  28.                 If .Rows.Count > 1 Then                '
  29.                     For I = 2 To .Rows.Count           '從第2列開始
  30.                         .Rows(I).Interior.Color = vbYellow
  31.                         .Rows(I).Cells(4) = 0
  32.                         .Rows(I).Cells(4).Font.Color = vbRed
  33.                     Next
  34.                 End If
  35.             End With
  36.         Next
  37.     End With
  38. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

b9208

帖子
182 
主題
34 
精華
0 
積分
316 
點名
0  
作業系統
Win 7 
軟體版本
Office 2010 
閱讀權限
20 
性別
男 
來自
Taiwan 
註冊時間
2010-5-2 
最後登錄
2023-6-24 
4#
發表於 2013-4-14 23:02 | 只看該作者
回復 3# b9208
排序範圍：
左上角[A6]，右下角為不定算，依照資料而定( 可能包含空白列或欄）
100 字節以內
不支持自定義 Discuz! 代碼

TOP

b9208

帖子
182 
主題
34 
精華
0 
積分
316 
點名
0  
作業系統
Win 7 
軟體版本
Office 2010 
閱讀權限
20 
性別
男 
來自
Taiwan 
註冊時間
2010-5-2 
最後登錄
2023-6-24 
3#
發表於 2013-4-14 22:30 | 只看該作者
回復 2# GBKEE
謝謝版主
執行ok
不了解Exists & Phonetic 函數，上網查也不解。
不知道下面句子含義
If Not D.EXISTS(Application.Phonetic(.Rows(I))) Then
     Set D(Application.Phonetic(.Rows(I))) = .Rows(I)
  Else
     Set D(Application.Phonetic(.Rows(I))) = Union(D(Application.Phonetic(.Rows(I))), .Rows(I))
End If
以上謝謝
100 字節以內
不支持自定義 Discuz! 代碼

TOP

GBKEE

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

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
2#
發表於 2013-4-14 17:49 | 只看該作者
回復 1# b9208
試試看
  1. Option Explicit
  2. Sub Ex()
  3.     Dim DataBase As Range, I As Integer, D As Object, D_Item As Variant
  4.     Set D = CreateObject("SCRIPTING.DICTIONARY")                            '字典物件
  5.     With Sheets("工作表1")
  6.         Set DataBase = .Range("A5").Resize(.[B5].End(xlDown).Row - 4, 9)    '制定範圍
  7.     End With
  8.     With DataBase
  9.         .Sort Key1:=.Cells(1, 2), Order1:=xlAscending, Key2:=.Cells(1, 3), Order2:=xlAscending, Key3:=.Cells(1, 4), Order3:=xlAscending, Header:=xlYes
  10.                                                                              '排序
  11.         For I = 1 To .Rows.Count
  12.             If Not D.EXISTS(Application.Phonetic(.Rows(I))) Then
  13.                 Set D(Application.Phonetic(.Rows(I))) = .Rows(I)             ''字典物件的內容: 為Range
  14.             Else
  15.                 Set D(Application.Phonetic(.Rows(I))) = Union(D(Application.Phonetic(.Rows(I))), .Rows(I))
  16.                                                        'Union 方法 傳回兩個或多個範圍的合併範圍。
  17.             End If
  18.         Next
  19.         For Each D_Item In D.ITEMS                     '依序傳回 字典物件的內容
  20.             With D_Item                                '字典物件的內容: 為Range
  21.                 If .Rows.Count > 1 Then                '
  22.                     For I = 2 To .Rows.Count           '從第2列開始
  23.                         .Rows(I).Interior.Color = vbYellow
  24.                         .Rows(I).Cells(4) = 0
  25.                         .Rows(I).Cells(4).Font.Color = vbRed
  26.                     Next
  27.                 End If
  28.             End With
  29.         Next
  30.     End With
  31. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

        靜思自在 : 天上最美是星星，人生最美是溫情。
返回列表 上一主題