返回列表 上一主題 發帖

匯出_但不重覆匯出的資料

Hsieh

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

2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
1# 跳轉到 »
發表於 2011-1-4 12:01 | 顯示全部帖子
回復 1# hugh0620
  1. Private Sub CommandButton1_Click()
  2. Dim Ay()
  3. Set d = CreateObject("Scripting.Dictionary")
  4. With Sheet2
  5. ar = .Range(.[B5], .[B5].End(xlDown).Offset(, 2))
  6. For i = 1 To UBound(ar, 1)
  7. mystr = Join(Application.Index(ar, i))
  8. d(mystr) = d.Count
  9. Next
  10. With Sheet1
  11. ar = .Range(.[B5], .[B5].End(xlDown).Offset(, 3))
  12. For i = 1 To UBound(ar, 1)
  13. mystr = Join(Array(ar(i, 1), ar(i, 2), ar(i, 3)))
  14. If d.exists(mystr) = False Then
  15. ReDim Preserve Ay(s)
  16. Ay(s) = Application.Index(ar, i)
  17. s = s + 1
  18. End If
  19. Next
  20. End With
  21. If s > 0 Then .[B65536].End(xlUp).Offset(1, 0).Resize(s, 4) = Application.Transpose(Application.Transpose(Ay))
  22. End With
  23. End Sub
複製代碼
學海無涯_不恥下問

TOP

Hsieh

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

2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
2#
發表於 2011-1-4 15:38 | 顯示全部帖子
本帖最後由 Hsieh 於 2011-1-4 15:49 編輯

回復 3# hugh0620
  1. Private Sub CommandButton1_Click()
  2. Dim Ay()
  3. Set d = CreateObject("Scripting.Dictionary")
  4. With Sheet2
  5.     ar = .Range(.[B5], .[B5].End(xlDown).Offset(, 2))
  6.         For i = 1 To UBound(ar, 1)
  7.             mystr1 = Join(Application.Index(ar, i))
  8.             d(mystr1) = d.Count
  9.         Next

  11.     With Sheet1
  12.         ar = .Range(.[B5], .[B5].End(xlDown).Offset(, 6))
  13.         For i = 1 To UBound(ar, 1)
  14.             mystr1 = Join(Array(ar(i, 1), ar(i, 2), ar(i, 6)))
  15.             If d.exists(mystr1) = False Then
  16.                 ReDim Preserve Ay(s)
  17.                 Ay(s) = Array(ar(i, 1), ar(i, 2), ar(i, 6), ar(i, 7))
  18.                 s = s + 1
  19.             End If
  20.         Next
  21.     End With
  22.     If s > 0 Then .[B65536].End(xlUp).Offset(1, 0).Resize(s, 4) = Application.Transpose(Application.Transpose(Ay))
  23. End With

  25. End Sub
複製代碼
學海無涯_不恥下問

TOP

Hsieh

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

2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
3#
發表於 2011-1-4 20:03 | 顯示全部帖子
回復 7# hugh0620
  1. Private Sub CommandButton1_Click()
  2. Dim Ay()
  3. Set d = CreateObject("Scripting.Dictionary")
  4. With Sheet2
  5.     ar = .Range(.[B5], .[B65536].End(xlUp).Offset(, 2))
  6.         For i = 1 To UBound(ar, 1)
  7.             mystr1 = Join(Application.Index(ar, i))
  8.             d(mystr1) = d.Count
  9.         Next

  11.     With Sheet1
  12.         ar = .Range(.[B5], .[B65536].End(xlUp).Offset(, 6))
  13.         For i = 1 To UBound(ar, 1)
  14.             mystr1 = Join(Array(ar(i, 1), ar(i, 2), ar(i, 6)))
  15.             If d.exists(mystr1) = False Then
  16.                 ReDim Preserve Ay(s)
  17.                 Ay(s) = Array(ar(i, 1), ar(i, 2), ar(i, 6), ar(i, 7))
  18.                 s = s + 1
  19.             End If
  20.         Next
  21.     End With
  22.     If s > 0 Then .[B65536].End(xlUp).Offset(1, 0).Resize(s, 4) = Application.Transpose(Application.Transpose(Ay))
  23. End With
  24. End Sub
複製代碼
學海無涯_不恥下問

TOP

Hsieh

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

2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
4#
發表於 2011-1-6 18:30 | 顯示全部帖子
本帖最後由 Hsieh 於 2011-1-6 19:06 編輯

回復 9# hugh0620
  1. Private Sub CommandButton1_Click()

  3. Dim Ay()
  4. Set d = CreateObject("Scripting.Dictionary")
  5. With Sheet2
  6. .Unprotect "password"  'password指工作表保護密碼
  7.     ar = .Range(.[B5], .[B65536].End(xlUp).Offset(, 2))
  8.         For i = 1 To UBound(ar, 1)
  9.             mystr1 = Join(Application.Index(ar, i))
  10.             d(mystr1) = d.Count
  11.         Next

  13.     With Sheet1
  14.         ar = .Range(.[B5], .[B65536].End(xlUp).Offset(, 6))
  15.         For i = 1 To UBound(ar, 1)
  16.             mystr1 = Join(Array(ar(i, 1), ar(i, 2), ar(i, 6)))
  17.             If d.exists(mystr1) = False Then
  18.                 ReDim Preserve Ay(s)
  19.                 Ay(s) = Array(ar(i, 1), ar(i, 2), ar(i, 6), ar(i, 7))
  20.                 s = s + 1
  21.             End If
  22.         Next
  23.     End With
  24.     If s > 0 Then .[B65536].End(xlUp).Offset(1, 0).Resize(s, 4) = Application.Transpose(Application.Transpose(Ay))
  25.     .Protect "password"  'password指工作表保護密碼
  26. End With

  28. End Sub
複製代碼
學海無涯_不恥下問

TOP

Hsieh

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

2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
5#
發表於 2011-1-10 11:40 | 顯示全部帖子
回復 12# hugh0620
那就乖一點
  1. Private Sub CommandButton1_Click()

  3. Dim Ay()
  4. Set d = CreateObject("Scripting.Dictionary")
  5. With Sheet2
  6. .Unprotect "1234"


  9.     ar = .Range(.[B5], .[B65536].End(xlUp).Offset(, 2))
  10.         For i = 1 To UBound(ar, 1)
  11.             mystr1 = Join(Array(ar(i, 1), ar(i, 2), ar(i, 3)))
  12.             d(mystr1) = d.Count
  13.         Next

  15.     With Sheet1
  16.         ar = .Range(.[B5], .[B65536].End(xlUp).Offset(, 6))
  17.         For i = 1 To UBound(ar, 1)
  18.             mystr1 = Join(Array(ar(i, 1), ar(i, 2), ar(i, 6)))
  19.             If d.exists(mystr1) = False Then
  20.                 ReDim Preserve Ay(s)
  21.                 Ay(s) = Array(ar(i, 1), ar(i, 2), ar(i, 6), ar(i, 7))
  22.                 s = s + 1
  23.             End If
  24.         Next
  25.     End With
  26.     If s > 0 Then .[B65536].End(xlUp).Offset(1, 0).Resize(s, 4) = Application.Transpose(Application.Transpose(Ay))
  27.     .Protect "1234"

  29. End With

  31. End Sub
複製代碼
學海無涯_不恥下問

TOP

Hsieh

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

2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
6#
發表於 2011-1-12 16:14 | 顯示全部帖子
回復 15# hugh0620
  1. Private Sub CommandButton1_Click()
  2. Dim Ay()
  3. Set d = CreateObject("Scripting.Dictionary")
  4. Set d1 = CreateObject("Scripting.Dictionary")
  5. With Sheet2
  6. .Unprotect "1234"
  7.     ar = .Range(.[B5], .[B65536].End(xlUp).Offset(, 2))
  8.         For i = 1 To UBound(ar, 1)
  9.             mystr1 = Join(Array(ar(i, 1), ar(i, 2), ar(i, 3)))
  10.             d(mystr1) = d.Count
  11.         Next
  12.     With Sheet1
  13.         ar = .Range(.[B5], .[B65536].End(xlUp).Offset(, 6))
  14.         For i = 1 To UBound(ar, 1)
  15.             mystr1 = Join(Array(ar(i, 1), ar(i, 2), ar(i, 6)))
  16.             If d.exists(mystr1) = False Then
  17.                 ReDim Preserve Ay(s)
  18.                 Ay(s) = Array(ar(i, 1), ar(i, 2), ar(i, 6), ar(i, 7))
  19.                 s = s + 1
  20.                 Else
  21.                 d1(mystr1) = ar(i, 7)
  22.             End If
  23.         Next
  24.     End With
  25.     For Each a In .Range(.[B5], .[B65536].End(xlUp))
  26.       mystr1 = Join(Array(a, a.Offset(, 1), a.Offset(, 2)))
  27.       a.Offset(, 3) = d1(mystr1)
  28.     Next
  29.     If s > 0 Then .[B65536].End(xlUp).Offset(1, 0).Resize(s, 4) = Application.Transpose(Application.Transpose(Ay))
  30.     .Protect "1234"
  31. End With
  32. End Sub
複製代碼
學海無涯_不恥下問

TOP

Hsieh

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

2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
7#
發表於 2011-1-19 17:10 | 顯示全部帖子
回復 17# hugh0620


    你不是希望覆寫嗎?
當然比對到重複的就被新的取代阿
學海無涯_不恥下問

TOP

        靜思自在 : 心中常存善解、包容、感思、知足、惜福。
返回列表 上一主題