bhsm

中學生 Rank: 2

帖子: 96
主題: 12
精華: 0
積分: 116
點名: 297
作業系統: XP
軟體版本: OFFICE2003
閱讀權限: 20
性別: 男
註冊時間: 2010-9-29
最後登錄: 2024-12-23

2023年全勤獎章 2022虎年全勤獎章 2021牛年全勤獎章 2020鼠年全勤獎章 2019 豬年全勤獎章 2018 狗年全勤獎章 2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章

1^# 跳轉到 » 倒序看帖

打印

字體大小: tT

發表於 2012-4-13 13:14 | 只看該作者

請教比對工作表相同的項目

各位前輩好:
小弟想比較8個工作表中A欄相同的值,列於Main工作表中,小弟有參考網路的前輩寫的VBA自行修改,但卻無法比對,不知VBA哪裡有錯?請指教.謝謝.

比較.rar (15.22 KB)

樓主熱帖

年齡不小,但我很想學

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兔年全勤獎章

2^#

發表於 2012-4-13 13:49 | 只看該作者

回復 1# bhsm
A欄相同的值要說明白

TOP

bhsm

中學生 Rank: 2

帖子: 96
主題: 12
精華: 0
積分: 116
點名: 297
作業系統: XP
軟體版本: OFFICE2003
閱讀權限: 20
性別: 男
註冊時間: 2010-9-29
最後登錄: 2024-12-23

2023年全勤獎章 2022虎年全勤獎章 2021牛年全勤獎章 2020鼠年全勤獎章 2019 豬年全勤獎章 2018 狗年全勤獎章 2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章

3^#

發表於 2012-4-13 15:53 | 只看該作者

對不起沒說清楚
以"2883開發金"為例,在"一銀.台銀.土銀.台企.兆豐.合庫.華南.彰銀"工作表中.共出現7次
以"2330台積電"為例,在"一銀.台銀.土銀.台企.兆豐.合庫.華南.彰銀"工作表中.共出現6次
其他還有各股各出現的次數
想請教的是: 是否可用vba找出在這8個工作表中.同時出現的股票及次數填入Main工作表中.謝謝

年齡不小,但我很想學

TOP

register313

　頭銜: 麻辣路人甲

大學生 Rank: 4

帖子: 967
主題: 0
精華: 0
積分: 1001
點名: 0
作業系統: WIN XP
軟體版本: OFFICE 2003
閱讀權限: 50
性別: 男
來自: 台北
註冊時間: 2010-11-29
最後登錄: 2022-5-17

2012龍年全勤獎章熱烈參與勳章

4^#

發表於 2012-4-13 19:50 | 只看該作者

回復 3# bhsm

Sub YY()
R = 1: C = 0
Sheets("相同").Columns("A:B") = ""
For Each Sh In Sheets
If Sh.Name <> "相同" Then
For Each Rng In Range(Sh.[A6], Sh.[A6].End(xlDown))
With Sheets("相同")
If Application.CountIf(.Columns("A"), Rng.Value) = 0 Then
.Cells(R, 1) = Rng.Value
.Cells(R, 2) = C + 1
R = R + 1
Else
x = Application.Match(Rng.Value, .Columns("A"), 0)
.Cells(x, 2) = .Cells(x, 2) + 1
End If
End With
Next
End If
Next
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兔年全勤獎章

5^#

發表於 2012-4-13 21:18 | 只看該作者

本帖最後由 GBKEE 於 2012-4-13 21:30 編輯

回復 3# bhsm
還有賣超一併回答使用工作表指令資料 -> 合併彙算很快的

Option Explicit
Sub Ex()
Dim Ar1(), Ar2(), xl As Integer, Rng As Range, xF As Range
Sheets("相同").Move Before:=Sheets(1)
ReDim Ar1(2 To Sheets.Count)
ReDim Ar2(2 To Sheets.Count)
For xl = 2 To Sheets.Count
With Sheets(xl)
Set Rng = .Range("A5", .[A5].End(xlDown)(1, 2))
Ar1(xl) = Rng.Address(, , xlR1C1, 1)
Set Rng = .Range("E5", .[E5].End(xlDown)(1, 2))
Ar2(xl) = Rng.Address(, , xlR1C1, 1)
End With
Next
With Sheets(1)
.Cells = ""
.[A1] = "買超"
.[A2].Consolidate Sources:=Ar1, Function:=xlCount, TopRow:=False, LeftColumn:=True, CreateLinks:=False
.[A2].Consolidate Sources:=Ar1, Function:=xlCount, TopRow:=True, LeftColumn:=True, CreateLinks:=False
.[E1] = "賣超"
.[E2].Consolidate Sources:=Ar2, Function:=xlCount, TopRow:=False, LeftColumn:=True, CreateLinks:=False
.[E2].Consolidate Sources:=Ar2, Function:=xlCount, TopRow:=True, LeftColumn:=True, CreateLinks:=False
End With
End Sub