123
返回列表 上一主題 發帖

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

hugh0620
　暱稱: VBA向前衝

高中生Rank: 3Rank: 3

帖子
559 
主題
58 
精華
0 
積分
626 
點名
0  
作業系統
win8 
軟體版本
office2013 
閱讀權限
50 
性別
男 
來自
TW 
註冊時間
2010-11-22 
最後登錄
2024-6-14 
1# 跳轉到 » 倒序看帖
打印
tT
發表於 2011-1-4 11:24 | 只看該作者

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

Dear 大大

     小弟又來發問問題了~ 但先祝各位大大新年快樂~ 以後多照顧 ^^
       小弟的問題在於將輸入好的資料匯出後,但要先比對Data中是否有重覆,以避免重覆計算

     1.使用者會在sheet[輸入]中,將資料輸入,再點選{匯出}
     2. 匯出時為避免重覆計算,其條件[日期]and[CPO]and[組別]三者不可以重覆

     如附件為問題濃縮的範例   匯出_但不重覆.rar (7.09 KB)
收藏 分享

Hsieh

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

2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
2#
發表於 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

hugh0620
　暱稱: VBA向前衝

高中生Rank: 3Rank: 3

帖子
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)

TOP

Hsieh

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

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
  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

hugh0620
　暱稱: VBA向前衝

高中生Rank: 3Rank: 3

帖子
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)
學習才能提升自己

TOP

hugh0620
　暱稱: VBA向前衝

高中生Rank: 3Rank: 3

帖子
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
學習才能提升自己

TOP

Hsieh

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

2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
7#
發表於 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

hugh0620
　暱稱: VBA向前衝

高中生Rank: 3Rank: 3

帖子
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給克服
學習才能提升自己

TOP

hugh0620
　暱稱: VBA向前衝

高中生Rank: 3Rank: 3

帖子
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)
學習才能提升自己

TOP

Hsieh

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

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
  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

        靜思自在 : 要批評別人時，先想想自己是否完美無缺。
123
返回列表 上一主題