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

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

2^#

發表於 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 & "")
   應如何修正?
十分感激收穫頗多

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

3^#

發表於 2012-9-3 22:19 | 顯示全部帖子

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

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

4^#

發表於 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)
應如何修正寫成(活的)?

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

5^#

發表於 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

6^#

發表於 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  三位大大