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

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

2023年全勤獎章 2022虎年全勤獎章 2021牛年全勤獎章 2020鼠年全勤獎章 2019 豬年全勤獎章 2018 狗年全勤獎章 2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱心公益勳章 2011兔年全勤獎章

2^#

發表於 2011-1-4 12:01 | 只看該作者

回復 1# hugh0620

Private Sub CommandButton1_Click()
Dim Ay()
Set d = CreateObject("Scripting.Dictionary")
With Sheet2
ar = .Range(.[B5], .[B5].End(xlDown).Offset(, 2))
For i = 1 To UBound(ar, 1)
mystr = Join(Application.Index(ar, i))
d(mystr) = d.Count
Next
With Sheet1
ar = .Range(.[B5], .[B5].End(xlDown).Offset(, 3))
For i = 1 To UBound(ar, 1)
mystr = Join(Array(ar(i, 1), ar(i, 2), ar(i, 3)))
If d.exists(mystr) = False Then
ReDim Preserve Ay(s)
Ay(s) = Application.Index(ar, i)
s = s + 1
End If
Next
End With
If s > 0 Then .[B65536].End(xlUp).Offset(1, 0).Resize(s, 4) = Application.Transpose(Application.Transpose(Ay))
End With
End Sub

複製代碼

學海無涯_不恥下問

　暱稱: VBA向前衝

帖子: 559
主題: 58
精華: 0
積分: 626
點名: 0
作業系統: win8
軟體版本: office2013
閱讀權限: 50
性別: 男
來自: TW
註冊時間: 2010-11-22
最後登錄: 2024-6-14

3^#

發表於 2011-1-4 14:11 | 只看該作者

回復 2# Hsieh

Dear 超版主大大

  真的很感謝你,很快的就解決我的問題,我也有將您的每行程式碼細細測試並了解
  大大用的方式是先將資料記錄起來,再用陣列的方式比對,看是否有不一樣的資料
  再將不一樣的資料記錄起來,最後再將不一樣的資料放在DATA中

  因為我給大大的範例是屬於條件式都是在一起的情況下,但是大大若我的條件修改為不是連續的情況下 (亦極條件與條件中間是有其他資料的時候)
  我有試著自行修改,但無奈小弟功力尚淺,無法用大大的模式修改好
  只好再請大大指教

  附件為問題之範例

匯出_但不重覆_延伸題.rar (10.68 KB)

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

2023年全勤獎章 2022虎年全勤獎章 2021牛年全勤獎章 2020鼠年全勤獎章 2019 豬年全勤獎章 2018 狗年全勤獎章 2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱心公益勳章 2011兔年全勤獎章

4^#

發表於 2011-1-4 15:38 | 只看該作者

本帖最後由 Hsieh 於 2011-1-4 15:49 編輯

回復 3# hugh0620

Private Sub CommandButton1_Click()
Dim Ay()
Set d = CreateObject("Scripting.Dictionary")
With Sheet2
ar = .Range(.[B5], .[B5].End(xlDown).Offset(, 2))
For i = 1 To UBound(ar, 1)
mystr1 = Join(Application.Index(ar, i))
d(mystr1) = d.Count
Next
With Sheet1
ar = .Range(.[B5], .[B5].End(xlDown).Offset(, 6))
For i = 1 To UBound(ar, 1)
mystr1 = Join(Array(ar(i, 1), ar(i, 2), ar(i, 6)))
If d.exists(mystr1) = False Then
ReDim Preserve Ay(s)
Ay(s) = Array(ar(i, 1), ar(i, 2), ar(i, 6), ar(i, 7))
s = s + 1
End If
Next
End With
If s > 0 Then .[B65536].End(xlUp).Offset(1, 0).Resize(s, 4) = Application.Transpose(Application.Transpose(Ay))
End With
End Sub

複製代碼

學海無涯_不恥下問

　暱稱: VBA向前衝

帖子: 559
主題: 58
精華: 0
積分: 626
點名: 0
作業系統: win8
軟體版本: office2013
閱讀權限: 50
性別: 男
來自: TW
註冊時間: 2010-11-22
最後登錄: 2024-6-14

5^#

發表於 2011-1-4 17:59 | 只看該作者

回復 4# Hsieh

Dear 大大
      感謝~ 我知道要改哪邊了~ 程式碼執行上也沒有問題~
         但是小弟在測試時~ 又胡思亂想~ 結果~ 找出了一個問題~
         就是若Data中~一開始就沒有資料或是僅一筆資料的時候好像是就會產生問題~
         For i = 1 To UBound(ar, 1) 該行指令中UBound(ar, 1) 就會等於65536 造成一直跑不停

      再請大大賜教一下

      附件為問題之範本

匯出_但不重覆_延伸題2.rar (10.98 KB)

學習才能提升自己

　暱稱: VBA向前衝

帖子: 559
主題: 58
精華: 0
積分: 626
點名: 0
作業系統: win8
軟體版本: office2013
閱讀權限: 50
性別: 男
來自: TW
註冊時間: 2010-11-22
最後登錄: 2024-6-14

6^#

發表於 2011-1-4 18:19 | 只看該作者

回復 4# Hsieh

Dear 大大
   我用一個很笨的方式來處理當DATA無資料時,所產生的問題
   不知道大大是否有其他方式
   這是我用大大的程式碼修改 (紅色為我新增的地方)
Dim Ay()
Set d = CreateObject("Scripting.Dictionary")
With Sheet2
ar = .Range(.[B5], .[B5].End(xlDown).Offset(, 2))
      If UBound(ar, 1) = 0 Or UBound(ar, 1) = 65536 - 4 Then
         For i = 1 To 1
            mystr1 = Join(Application.Index(ar, i))
            d(mystr1) = d.Count
         Next
      Else          For i = 1 To UBound(ar, 1)
            mystr1 = Join(Application.Index(ar, i))
            d(mystr1) = d.Count
         Next
      End If With Sheet1
      ar = .Range(.[B5], .[B5].End(xlDown).Offset(, 6))
      For i = 1 To UBound(ar, 1)
         mystr1 = Join(Array(ar(i, 1), ar(i, 2), ar(i, 6)))
         If d.exists(mystr1) = False Then
            ReDim Preserve Ay(s)
            Ay(s) = Array(ar(i, 1), ar(i, 2), ar(i, 6), ar(i, 7))
            s = s + 1
         End If
      Next
End With
If s > 0 Then .[B65536].End(xlUp).Offset(1, 0).Resize(s, 4) = Application.Transpose(Application.Transpose(Ay))
End With

學習才能提升自己

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

2023年全勤獎章 2022虎年全勤獎章 2021牛年全勤獎章 2020鼠年全勤獎章 2019 豬年全勤獎章 2018 狗年全勤獎章 2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱心公益勳章 2011兔年全勤獎章

7^#

發表於 2011-1-4 20:03 | 只看該作者

回復 7# hugh0620

Private Sub CommandButton1_Click()
Dim Ay()
Set d = CreateObject("Scripting.Dictionary")
With Sheet2
ar = .Range(.[B5], .[B65536].End(xlUp).Offset(, 2))
For i = 1 To UBound(ar, 1)
mystr1 = Join(Application.Index(ar, i))
d(mystr1) = d.Count
Next
With Sheet1
ar = .Range(.[B5], .[B65536].End(xlUp).Offset(, 6))
For i = 1 To UBound(ar, 1)
mystr1 = Join(Array(ar(i, 1), ar(i, 2), ar(i, 6)))
If d.exists(mystr1) = False Then
ReDim Preserve Ay(s)
Ay(s) = Array(ar(i, 1), ar(i, 2), ar(i, 6), ar(i, 7))
s = s + 1
End If
Next
End With
If s > 0 Then .[B65536].End(xlUp).Offset(1, 0).Resize(s, 4) = Application.Transpose(Application.Transpose(Ay))
End With
End Sub

複製代碼

學海無涯_不恥下問

　暱稱: VBA向前衝

帖子: 559
主題: 58
精華: 0
積分: 626
點名: 0
作業系統: win8
軟體版本: office2013
閱讀權限: 50
性別: 男
來自: TW
註冊時間: 2010-11-22
最後登錄: 2024-6-14

8^#

發表於 2011-1-5 09:36 | 只看該作者

回復 7# Hsieh

謝謝大大~ 原來只要把xldown 改成xlup就可以將bug給克服

學習才能提升自己

　暱稱: VBA向前衝

帖子: 559
主題: 58
精華: 0
積分: 626
點名: 0
作業系統: win8
軟體版本: office2013
閱讀權限: 50
性別: 男
來自: TW
註冊時間: 2010-11-22
最後登錄: 2024-6-14

9^#

發表於 2011-1-6 18:14 | 只看該作者

回復 7# Hsieh

Dear 大大

      小弟又小卡彈了~ 大大我需要將資料匯出,但是Data的部份又要保護避免被使用者修改(使用者僅能看)
         如果我把工作頁保護了,匯出的時候程式執行就會產生錯誤
      這樣的問題是否可以解決呢??

         附件為問題之範本

匯出_但不重覆_延伸題3.rar (12.41 KB)

學習才能提升自己

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

2023年全勤獎章 2022虎年全勤獎章 2021牛年全勤獎章 2020鼠年全勤獎章 2019 豬年全勤獎章 2018 狗年全勤獎章 2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱心公益勳章 2011兔年全勤獎章

10^#

發表於 2011-1-6 18:30 | 只看該作者

本帖最後由 Hsieh 於 2011-1-6 19:06 編輯

回復 9# hugh0620

Private Sub CommandButton1_Click()
Dim Ay()
Set d = CreateObject("Scripting.Dictionary")
With Sheet2
.Unprotect "password" 'password指工作表保護密碼
ar = .Range(.[B5], .[B65536].End(xlUp).Offset(, 2))
For i = 1 To UBound(ar, 1)
mystr1 = Join(Application.Index(ar, i))
d(mystr1) = d.Count
Next
With Sheet1
ar = .Range(.[B5], .[B65536].End(xlUp).Offset(, 6))
For i = 1 To UBound(ar, 1)
mystr1 = Join(Array(ar(i, 1), ar(i, 2), ar(i, 6)))
If d.exists(mystr1) = False Then
ReDim Preserve Ay(s)
Ay(s) = Array(ar(i, 1), ar(i, 2), ar(i, 6), ar(i, 7))
s = s + 1
End If
Next
End With
If s > 0 Then .[B65536].End(xlUp).Offset(1, 0).Resize(s, 4) = Application.Transpose(Application.Transpose(Ay))
.Protect "password" 'password指工作表保護密碼
End With
End Sub

複製代碼

學海無涯_不恥下問