相同姓名之條件下 部分資料轉移?

帖子: 258
主題: 77
精華: 0
積分: 385
點名: 0
作業系統: Win7
軟體版本: Office2010
閱讀權限: 20
性別: 男
來自: Taiwan
註冊時間: 2010-8-8
最後登錄: 2021-1-25

3^#

發表於 2012-9-3 17:53 | 只看該作者

本帖最後由 yangjie 於 2012-9-3 17:55 編輯

回復 2# Hsieh
謝謝Hsieh超級版大
   我用傳統一歩一歩來用了50多行效果不好
   因不會用Scripting.Dictionary
可否賜教以下不懂之處
1.       Set d = CreateObject("Scripting.Dictionary")
         With Workbooks("1.xls").Sheets(3)
                     For Each A In .Range(.[C2], .[C65536].End(xlUp))
                                 d(A & "") = Array(A.Offset(, 3).Value, A.Offset(, 4).Value, A.Offset(, 6).Value)
                     next
         其中 d(A & "") 為何要 &""
2.    With Workbooks("2.xls").Sheets(5)
                     For Each A In .Range(.[B2], .[B65536].End(xlUp))
                              A.Offset(, 1).Resize(, 3).Value = d(A & "")
                     Next
      End With
      何處得知是找相同資料條件?是否 A 之故?或是Dictionary之故?
3.  若貼上之處非相連之儲存格，則A.Offset(, 1).Resize(, 3).Value = d(A & "")
   應如何修正?
十分感激收穫頗多

Hsieh

超級版主 Rank: 8 Rank: 8

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

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

4^#

發表於 2012-9-3 18:16 | 只看該作者

回復 3# yangjie
1.為何要用A & ""
因為Dictionary物件是用關鍵字作索引，然後對應一個資料內容
例如:d(A & "")=Array(a1,b1,c1)
其中A & ""就是關鍵字，在程式中的A是儲存格型態，加上&""是把其內容轉成文字型態
當然如果使用d(A.Value)也行
而Array(a1,b1,c1)就是該索引對應的內容
2.根據問題1的回答就可知道，是先讀取所有資料到Dictionary物件
再來只需將對硬的內容從Dictionary物件中讀取出來
3.不連續儲存格當然無法用Resize來指定範圍
可以使用
A.Offset(,1)=d(A & "")(0)
A.Offset(,3)=d(A & "")(1)
A.Offset(,9)=d(A & "")(2)
這樣一一給值的方法

學海無涯_不恥下問

帖子: 258
主題: 77
精華: 0
積分: 385
點名: 0
作業系統: Win7
軟體版本: Office2010
閱讀權限: 20
性別: 男
來自: Taiwan
註冊時間: 2010-8-8
最後登錄: 2021-1-25

5^#

發表於 2012-9-3 22:19 | 只看該作者

回復 4# Hsieh
太棒了完全了解謝謝以後應會善加利用

帖子: 258
主題: 77
精華: 0
積分: 385
點名: 0
作業系統: Win7
軟體版本: Office2010
閱讀權限: 20
性別: 男
來自: Taiwan
註冊時間: 2010-8-8
最後登錄: 2021-1-25

6^#

發表於 2012-9-6 09:33 | 只看該作者

回復 4# Hsieh
謝謝Hsieh
若匯出之欄位數每次相異也就是變數(但可取得個數)
Set d = CreateObject("Scripting.Dictionary")
         With Workbooks("1.xls").Sheets(3)
                     For Each A In .Range(.[C2], .[C65536].End(xlUp))
                                    d(A & "") = Array(A.Offset(, 3).Value, A.Offset(, 4).Value, A.Offset(, 6).Value)
                     next
其中  d(A & "") = Array(A.Offset(, 3).Value, A.Offset(, 4).Value, A.Offset(, 6).Value,------)
因為用VBA 取得n1(1)=3, n1(2)=4, n1(3)=6, n1(4)=9 ,n1(5)=0,n1(6)=0,0,0,0,0------
而可能下一次VBA 取得n1(1)=5, n1(2)=7, n1(3)=0, n1(4)=0 ,n1(5)=0,n1(6)=0,0,0,0,0------
是故d(A & "") = Array(A.Offset(, 3).Value, A.Offset(, 4).Value, A.Offset(, 6).Value)
應如何修正寫成(活的)?

Hsieh

超級版主 Rank: 8 Rank: 8

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

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

7^#

發表於 2012-9-6 13:58 | 只看該作者

回復 6# yangjie

d(A & "")=array(A.Offset(,n1(1)).value,A.Offset(,n1(2)).value,A.Offset(,n1(3)).value,....

學海無涯_不恥下問

帖子: 258
主題: 77
精華: 0
積分: 385
點名: 0
作業系統: Win7
軟體版本: Office2010
閱讀權限: 20
性別: 男
來自: Taiwan
註冊時間: 2010-8-8
最後登錄: 2021-1-25

8^#

發表於 2012-9-6 22:44 | 只看該作者

回復 7# Hsieh
謝謝Hsieh
我的意思為若VBA 已抓到n1(1)=3,n1(2)=5兩個欄位之column
則 d(A & "")=array(A.Offset(,n1(1)-2).value,A.Offset(,n1(2)-2).value) '已columns(2)為準
若VBA 已抓到n1(1)=3,n1(2)=5,n1(3)=6三個欄位之column
則 d(A & "")=array(A.Offset(,n1(1)-2).value,A.Offset(,n1(2)-2).value,A.Offset(,n1(3)-2).value)
這兩式等等如何寫成一式(也可能為四個欄位)?

帖子: 258
主題: 77
精華: 0
積分: 385
點名: 0
作業系統: Win7
軟體版本: Office2010
閱讀權限: 20
性別: 男
來自: Taiwan
註冊時間: 2010-8-8
最後登錄: 2021-1-25

9^#

發表於 2012-9-7 02:59 | 只看該作者

回復 7# Hsieh
問題解決了
自行加入d1( )
然後
ReDim Preserve d1(i - 1)
      d1(i - 1) = a.Offset(, n1(i) - default1).Value '增加items
結果順利
Set d = CreateObject("Scripting.Dictionary")
   With Workbooks(str1).Sheets(sh1)
      For Each a In .Range(.Cells(2, default1), .Cells(65536, default1).End(xlUp))
         Dim d1()
         d1 = Array(a.Offset(, n1(1) - default1).Value)
         If s1 > 1 Then
               For i = 2 To s1
                  ReDim Preserve d1(i - 1)
                  d1(i - 1) = a.Offset(, n1(i) - default1).Value
               Next
         End If
         d(a & "") = d1
      Next
   End With
供大家參考指教
綜合多天來在各帖指導
謝謝 Kimbal  & Hsieh & GBKEE  三位大大