麻辣家族討論版版 - Powered by Discuz! Board

標題: 相同姓名之條件下部分資料轉移? [打印本頁]

作者: yangjie 時間: 2012-9-3 00:28 標題: 相同姓名之條件下部分資料轉移?

請教大大們:
workbook("1").sheets(3)中第三欄為姓名，workbook("2").sheets(5)中第二欄為姓名，
在相同姓名之條件下，將workbook("1").sheets(3)中第6,7,9欄資料填到workbook("2").sheets(5)接著最後空白三欄，
求助於大大可有VBA解決?
謝謝

作者: Hsieh 時間: 2012-9-3 16:41

回復 1# yangjie

Sub ex()
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
End With
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
End Sub

複製代碼

作者: yangjie 時間: 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 時間: 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)
這樣一一給值的方法

作者: yangjie 時間: 2012-9-3 22:19

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

作者: yangjie 時間: 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 時間: 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,....

作者: yangjie 時間: 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)
這兩式等等如何寫成一式(也可能為四個欄位)?

作者: yangjie 時間: 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  三位大大

歡迎光臨麻辣家族討論版版 (http://forum.twbts.com/)