返回列表 上一主題 發帖

[發問] 找出 相同的資料

john2006168
　暱稱: jjjohn

中學生Rank: 2

帖子
178 
主題
65 
精華
0 
積分
252 
點名
0  
作業系統
WINDOW7 
軟體版本
Office 2010 
閱讀權限
20 
性別
男 
來自
HK 
註冊時間
2010-5-4 
最後登錄
2024-2-1 
1# 跳轉到 » 倒序看帖
打印
tT
發表於 2010-6-21 23:25 | 只看該作者

[發問] 找出 相同的資料

本帖最後由 john2006168 於 2010-6-21 23:35 編輯

1.請問如果sheet1有些資料跟sheet2比較,相同的在指定的sheet "john" show 出來.
用vba怎麼寫??
2.如果不相同的,在指定的sheet "john" show 出來.
用vba又怎麼寫
TEST.zip (1.66 KB)
收藏 分享

GBKEE

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

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
2#
發表於 2010-6-22 07:34 | 只看該作者
回復 1# john2006168
John2006168: 在Sheet1中也有相同的資料 請問 是單一的(不)相同資料 還是多筆的(不)相同資料
請附上含相同及不相同資料範例

TOP

Hsieh

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

2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
3#
發表於 2010-6-22 08:42 | 只看該作者
回復 1# john2006168
  1. Sub Ex()
  2. Dim Ar(), Ay()
  3. Set d = CreateObject("Scripting.Dictionary")
  4. Set d1 = CreateObject("Scripting.Dictionary")
  5. Set d2 = CreateObject("Scripting.Dictionary")
  6. With Sheet1
  7. For Each a In .Range(.[A2], .[A65536].End(xlUp))
  8.    d(a.Value) = a.Value
  9.    d2(a.Value) = a.Value
  10. Next
  11. End With
  12. With Sheet2
  13. For Each a In .Range(.[A2], .[A65536].End(xlUp))
  14.    d1(a.Value) = a.Value
  15.    d2(a.Value) = a.Value
  16. Next
  17. End With
  18. ReDim Preserve Ar(s): Ar(s) = "相同Name": s = s + 1
  19. ReDim Preserve Ay(k): Ay(k) = "不同Name": k = k + 1
  20. For Each ky In d2.keys
  21.   If d.exists(ky) = True And d1.exists(ky) = True Then
  22.   ReDim Preserve Ar(s) '相同
  23.   Ar(s) = ky
  24.   s = s + 1
  25.   Else
  26.   ReDim Preserve Ay(k) '不同
  27.   Ay(k) = ky
  28.   k = k + 1
  29.   End If
  30. Next
  31. With Sheet3
  32. .Cells = ""
  33. .[A1].Resize(s, 1) = Application.Transpose(Ar)
  34. .[B1].Resize(k, 1) = Application.Transpose(Ay)
  35. End With
  36. End Sub
複製代碼
學海無涯_不恥下問

TOP

Andy2483
　暱稱: 厚臉皮的學生

大學生Rank: 4

帖子
1446 
主題
40 
精華
0 
積分
1470 
點名
0  
作業系統
Windows 7 
軟體版本
Excel 2010 & 2016 
閱讀權限
50 
性別
男 
來自
台灣 
註冊時間
2020-7-15 
最後登錄
2024-10-21 
4#
發表於 2022-10-18 16:43 | 只看該作者
謝謝前輩們
今天練習陣列與字典

Option Explicit
Sub TEST()
Dim i&, x&, Y, Z
Set Y = CreateObject("Scripting.Dictionary")
Set Z = CreateObject("Scripting.Dictionary")
For x = 1 To 2
   Y(x) = Sheets(x).Range("A1:A" & Sheets(x).[A65536].End(3).Row)
   Y(x) = Application.Transpose(Y(x))
   For i = 1 To UBound(Y(x))
      Z(Y(x)(i)) = ""
   Next
   Y(x + 2) = Application.Transpose(Z.KEYS)
   Z.RemoveAll
Next
For x = 3 To 4
   For i = 2 To UBound(Y(x))
      If Z(Y(x)(i, 1)) = "" Then
         Y(5) = Y(5) & Y(x)(i, 1) & "|"
         Z(Y(x)(i, 1)) = Z(Y(x)(i, 1)) + 1
         Else
            Y(6) = Y(6) & Y(x)(i, 1) & "|"
            Y(5) = Replace(Y(5), Y(x)(i, 1) & "|", "")
      End If
   Next
Next
Y(6) = Application.Transpose(Split(Y(6), "|"))
Y(5) = Application.Transpose(Split(Y(5), "|"))
Workbooks.Add
[A1].Resize(, 2) = Array("相同", "不同")
[A2].Resize(UBound(Y(6)), 1) = Y(6)
[B2].Resize(UBound(Y(5)), 1) = Y(5)
End Sub

TOP

Andy2483
　暱稱: 厚臉皮的學生

大學生Rank: 4

帖子
1446 
主題
40 
精華
0 
積分
1470 
點名
0  
作業系統
Windows 7 
軟體版本
Excel 2010 & 2016 
閱讀權限
50 
性別
男 
來自
台灣 
註冊時間
2020-7-15 
最後登錄
2024-10-21 
5#
發表於 2022-10-20 13:17 | 只看該作者
回復 4# Andy2483
各位前輩好:
1.直接在字典裡裡面的陣列值引用或編輯很耗時間
2.反而把陣列提取出來做陣列值引用或編輯比較快
3.資料少差異不大!改5000筆資料就差很多了!
4.Application.Transpose()轉置的方式比較慢
TEST_20221018_20_4.zip (69.19 KB)

Hsieh前輩的方式比較快:


上一樓的方式超慢:


改良一下,稍好:

TOP

Andy2483
　暱稱: 厚臉皮的學生

大學生Rank: 4

帖子
1446 
主題
40 
精華
0 
積分
1470 
點名
0  
作業系統
Windows 7 
軟體版本
Excel 2010 & 2016 
閱讀權限
50 
性別
男 
來自
台灣 
註冊時間
2020-7-15 
最後登錄
2024-10-21 
6#
發表於 2022-10-20 16:16 | 只看該作者
謝謝各位前輩提供這麼多知識在論壇上
今天後學練習到要注意執行效能!
心得註解如下!請各位前輩指正並指導!謝謝!
Option Explicit
Sub TEST_2()
Dim i&, x&, Y, Z, Arr, Brr, Crr, T
'↑宣告變數
T = Timer
Set Y = CreateObject("Scripting.Dictionary")
Set Z = CreateObject("Scripting.Dictionary")
'↑令Y,Z各是字典
For x = 1 To 2
'↑設外順迴圈把兩表資料 用Z字典整理 為不重複並各將Z字典轉置為陣列
',再裝入字典成為Y(3), Y(4)
   Y(x) = Sheets(x).Range("A1:A" & Sheets(x).[A65536].End(3).Row)
   Y(x) = Application.Transpose(Y(x))
   '↑盡量不用轉置的方式處理資料!一兩次還好!多次耗時!
   Crr = Y(x)
   '↑需要用Crr將字典裡的陣列盛裝出來執行比較快
   For i = 1 To UBound(Crr)
      Z(Crr(i)) = ""
   Next
   Y(x + 2) = Application.Transpose(Z.KEYS)
   '↑盡量不用轉置的方式處理資料!一兩次還好!多次耗時!
   Z.RemoveAll
Next
For x = 3 To 4
'↑設外順迴圈把兩陣列資料分類並組成字串
   Crr = Y(x)
   '↑需要用Crr將字典裡的陣列盛裝出來執行比較快
   For i = 2 To UBound(Crr)
      If Z(Crr(i, 1)) = "" Then
         Arr = Arr & Crr(i, 1) & "|"
         Z(Crr(i, 1)) = Z(Crr(i, 1)) + 1
         Else
            Brr = Brr & Crr(i, 1) & "|"
            Arr = Replace(Arr, Crr(i, 1) & "|", "")
      End If
   Next
Next
Brr = Application.Transpose(Split(Brr, "|"))
Arr = Application.Transpose(Split(Arr, "|"))
'↑將Arr,Brr字串 用"|" 符號拆解為一維陣列,並轉置為結果
'因為Arr,Brr宣告沒有指定是什麼類型資料!所以可以變換類型!
With Sheets(3)
   .[I1].Resize(, 2) = Array("相同", "不同")
   .[I2].Resize(UBound(Brr), 1) = Brr
   .[J2].Resize(UBound(Arr), 1) = Arr
End With
Set Y = Nothing
Set Z = Nothing
Set Arr = Nothing
Set Brr = Nothing
Set Crr = Nothing
MsgBox Timer - T & "秒"
End Sub

TOP

        靜思自在 : 虛空有盡．我願無窮，發願容易行願難。
返回列表 上一主題