123
返回列表 上一主題 發帖

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

hugh0620
　暱稱: VBA向前衝

高中生Rank: 3Rank: 3

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


    謝謝大大~ 問題解決了
        只要在匯前解開(Unprotect)與匯後鎖上就好了(Protect)

   真是感謝大大~ 我的整份報表慢慢將完成
學習才能提升自己

TOP

hugh0620
　暱稱: VBA向前衝

高中生Rank: 3Rank: 3

帖子
559 
主題
58 
精華
0 
積分
626 
點名
0  
作業系統
win8 
軟體版本
office2013 
閱讀權限
50 
性別
男 
來自
TW 
註冊時間
2010-11-22 
最後登錄
2024-6-14 
12#
發表於 2011-1-10 11:28 | 只看該作者
回復 10# Hsieh

   Dear 大大

   小小卡彈中,若是sheet[Data]中已有一筆資,我經過測試後,在活頁[輸入]就匯不過去了,
    執行的時候發現是 mystr1 = Join(Application.Index(ar, i)) 這行指令會產生{執行階段錯誤"13" 型態不符}
    請大大指導一下~

   問題如附件之範本 匯出_但不重覆_延伸題4.rar (12.54 KB)
學習才能提升自己

TOP

Hsieh

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

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

hugh0620
　暱稱: VBA向前衝

高中生Rank: 3Rank: 3

帖子
559 
主題
58 
精華
0 
積分
626 
點名
0  
作業系統
win8 
軟體版本
office2013 
閱讀權限
50 
性別
男 
來自
TW 
註冊時間
2010-11-22 
最後登錄
2024-6-14 
14#
發表於 2011-1-10 11:54 | 只看該作者
回復 13# Hsieh


    Dear 大大~ 感恩~ 原來只要把那行程式碼改成array的方式就可以解決
         真的很感謝你~
學習才能提升自己

TOP

hugh0620
　暱稱: VBA向前衝

高中生Rank: 3Rank: 3

帖子
559 
主題
58 
精華
0 
積分
626 
點名
0  
作業系統
win8 
軟體版本
office2013 
閱讀權限
50 
性別
男 
來自
TW 
註冊時間
2010-11-22 
最後登錄
2024-6-14 
15#
發表於 2011-1-12 11:16 | 只看該作者
回復 13# Hsieh


     Dear 大大

         若是重覆的資料,有資料是KEY IN錯誤,但是已經按了匯出資料,
             需要將依匯出的條件UPDATE錯務的地方,請大大指教一下


          附件為問題之範本 匯出_但不重覆_延伸題5 (重覆資料更新).rar (12.45 KB)
學習才能提升自己

TOP

Hsieh

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

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

hugh0620
　暱稱: VBA向前衝

高中生Rank: 3Rank: 3

帖子
559 
主題
58 
精華
0 
積分
626 
點名
0  
作業系統
win8 
軟體版本
office2013 
閱讀權限
50 
性別
男 
來自
TW 
註冊時間
2010-11-22 
最後登錄
2024-6-14 
17#
發表於 2011-1-19 16:49 | 只看該作者
回復 16# Hsieh


    大大~ 因為輸日介面會每日一直輸入~ 若是這樣
   測試後的結果會有一個問題~ 就是如果第1次(依日期:第1天)輸入~ 按匯出後~ DATA會帶出數量~
    但是~ 第2次(依日期:第2天)輸入~ 按匯出後~ DATA會帶出第2次輸入的數量~ 但是第一次輸入的數量會不見~>.<
學習才能提升自己

TOP

Hsieh

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

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


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

TOP

hugh0620
　暱稱: VBA向前衝

高中生Rank: 3Rank: 3

帖子
559 
主題
58 
精華
0 
積分
626 
點名
0  
作業系統
win8 
軟體版本
office2013 
閱讀權限
50 
性別
男 
來自
TW 
註冊時間
2010-11-22 
最後登錄
2024-6-14 
19#
發表於 2011-1-19 17:28 | 只看該作者
回復 18# Hsieh

    大大明鑑
    覆寫的部份針對的是[同一天]且[同一個CPO]且[同一組]的條件下進行覆寫DATA同樣的資料
   若是[不同天]或[不同CPO]或[不同組]就需要新增資料到DATA
學習才能提升自己

TOP

Andy2483
　暱稱: 厚臉皮的學生

大學生Rank: 4

帖子
1446 
主題
40 
精華
0 
積分
1470 
點名
0  
作業系統
Windows 7 
軟體版本
Excel 2010 & 2016 
閱讀權限
50 
性別
男 
來自
台灣 
註冊時間
2020-7-15 
最後登錄
2024-10-21 
20#
發表於 2023-3-15 20:13 | 只看該作者
本帖最後由 Andy2483 於 2023-3-15 20:20 編輯

回復 11# hugh0620
回復 16# Hsieh


    謝謝論壇,謝謝前輩
後學藉此帖學習到很多知識,以下心得註解,請前輩再指導

Option Explicit
Sub TEST()
Dim Ay(), d, d1, ar, i, a, s, mystr1
'↑宣告變數:Ay是陣列,其餘為通用型變數
Set d = CreateObject("Scripting.Dictionary")
'↑令d是 字典
Set d1 = CreateObject("Scripting.Dictionary")
'↑令d1也是 字典
With Sheet2
'↑以下是關於Sheet2工作表的程序 (Data表)
   .Unprotect "1234"
   '↑令以"1234"密碼取消保護工作表
   ar = .Range(.[B5], .[B65536].End(xlUp).Offset(, 2))
   '↑令ar變數是二維陣列,以[B5]到(B欄最後一個有內容儲存格,
   '再向右偏移2欄的儲存格),此範圍儲存格值帶入ar陣列中
   For i = 1 To UBound(ar, 1)
   '↑設順迴圈!i從1到 ar縱向最大索引列號
      mystr1 = Join(Array(ar(i, 1), ar(i, 2), ar(i, 3)))
      '↑令mystr1變數是以 空白字元連結陣列子值的新字串
      '陣列子值:i迴圈數的(1,2,3)欄ar陣列值
      d(mystr1) = d.Count
      '↑令以mystr1變數當key,item是 d字典key數量(PS:起始值是0),納入d字典
   Next
   With Sheet1
   '↑以下是關於Sheet1工作表的程序 (輸入表)
      ar = .Range(.[B5], .[B65536].End(xlUp).Offset(, 6))
      '↑令ar變數裝新資料:
      '令ar是二維陣列,以[B5]到(B欄最後一個有內容儲存格,
      '再向右偏移6欄的儲存格),此範圍儲存格值帶入ar陣列中
      For i = 1 To UBound(ar, 1)
      '↑設順迴圈!i從1到 ar縱向最大索引列號
         mystr1 = Join(Array(ar(i, 1), ar(i, 2), ar(i, 6)))
         '↑令mystr1變數是以 空白字元連結陣列子值的新字串
         '陣列子值:i迴圈數的(1,2,6)欄ar陣列值
         If d.exists(mystr1) = False Then
         '↑如果查d字典裡沒有 mystr1變數 key
            ReDim Preserve Ay(s)
            '↑令Ay陣列擴充列數到索引號s(PS:s起始值是0)
            Ay(s) = Array(ar(i, 1), ar(i, 2), ar(i, 6), ar(i, 7))
            '↑令s變索引號Ay陣列值是一維陣列,以i迴圈列ar陣列子值(1,2,6,7)帶入
            s = s + 1
            '↑令s變數累加 1
            Else
               d1(mystr1) = ar(i, 7)
               '↑否則令以mystr1變數為key,item是i迴圈列第7欄ar陣列值,納入d1字典中
         End If
      Next
   End With
   For Each a In .Range(.[B5], .[B65536].End(xlUp))
   '↑設逐項迴圈!令a是 (Data表[B5]到 B欄最後一個有內容儲存格)這範圍儲存格之一
      mystr1 = Join(Array(a, a.Offset(, 1), a.Offset(, 2)))
      '↑令mystr1變數是以 空白字元連結陣列子值的新字串
      '陣列子值:a變數值,a變數往右偏移1格的儲存格值,a變數往右偏移2格的儲存格值
      a.Offset(, 3) = d1(mystr1)
      '↑令a變數往右偏移3格的儲存格值是 以mystr1變數查d1字典的item值
   Next
   If s > 0 Then
   '↑如果s變數大於 0?
      .[B65536].End(xlUp).Offset(1, 0).Resize(s, 4) = _
      Application.Transpose(Application.Transpose(Ay))
      '↑令Data表B欄第1空白格擴展向下s1變數列,向右擴展4欄,
      '這擴展範圍儲存格值以Ay陣列轉置兩次的值帶入
   End If
   .Protect "1234"
   '↑令以"1234"密碼保護Data表
End With
End Sub
用行動裝置瀏覽論壇學習很方便,謝謝論壇經營團隊
請大家一起上論壇來交流

TOP

        靜思自在 : 忘功不忘過，忘怨不忘恩。
123
返回列表 上一主題