資料相同排在同一列的問題

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

1^# 跳轉到 »

發表於 2012-4-3 14:20 | 顯示全部帖子

回復 2# register313
不用字典物件可少用一次迴圈, 這不錯 ,可再簡化一下

Sub Ex()
Dim A As Range, xf As Integer
Sheet1.Activate
'Sheets("原始資料").Activate
Columns("D:IV") = ""
Columns("B:B").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("D6"), Unique:=True
For Each A In Range([B2], [B65536].End(xlUp))
xf = Application.Match(A, Columns("D"), 0)
Cells(xf, "IV").End(xlToLeft).Offset(, 1) = A.Offset(, -1)
Next
End Sub

複製代碼

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

2^#

發表於 2012-4-3 14:54 | 顯示全部帖子

回復 5# register313
我的工作用不上PC的,是興趣驅使來學習.有時也是回覆的七零八落地.

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

3^#

發表於 2012-4-3 20:37 | 顯示全部帖子

回復 8# hugh0620
由左向右由右向左隨個人喜好都可以

Option Explicit
Sub Ex()
Dim A As Range, xf As Integer, xC As Integer
Sheet1.Activate
'Sheets("原始資料").Activate
Columns("D:IV") = ""
Columns("B:B").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("D6"), Unique:=True
For Each A In Range([B2], [B65536].End(xlUp))
xf = Application.Match(A, Columns("D"), 0)
xC = Application.CountA(Range(Cells(xf, "D"), Cells(xf, "D").End(xlToRight)))
Cells(xf, "D").Offset(, xC) = A.Offset(, -1)
Next
End Sub

複製代碼

靜思自在 : 並非有錢魷是快樂，問心無愧心最安。