返回列表 上一主題 發帖

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

yangjie

帖子
258 
主題
77 
精華
0 
積分
385 
點名
0  
作業系統
Win7 
軟體版本
Office2010 
閱讀權限
20 
性別
男 
來自
Taiwan 
註冊時間
2010-8-8 
最後登錄
2021-1-25 
1# 跳轉到 » 正序看帖
打印
tT
發表於 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解決?
                                                             謝謝
收藏 分享

yangjie

帖子
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  三位大大

TOP

yangjie

帖子
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)
   這兩式等等如何寫成一式(也可能為四個欄位)?

TOP

Hsieh

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

2025年全勤獎章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,....
學海無涯_不恥下問

TOP

yangjie

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

TOP

yangjie

帖子
258 
主題
77 
精華
0 
積分
385 
點名
0  
作業系統
Win7 
軟體版本
Office2010 
閱讀權限
20 
性別
男 
來自
Taiwan 
註冊時間
2010-8-8 
最後登錄
2021-1-25 
5#
發表於 2012-9-3 22:19 | 只看該作者
回復 4# Hsieh
太棒了 完全了解  謝謝  以後應會善加利用

TOP

Hsieh

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

2025年全勤獎章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)
這樣一一給值的方法
學海無涯_不恥下問

TOP

yangjie

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

TOP

Hsieh

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

2025年全勤獎章2024年全勤獎章2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
2#
發表於 2012-9-3 16:41 | 只看該作者
回復 1# yangjie
  1. Sub ex()
  2. Set d = CreateObject("Scripting.Dictionary")
  3. With Workbooks("1.xls").Sheets(3)
  4.   For Each a In .Range(.[C2], .[C65536].End(xlUp))
  5.    d(a & "") = Array(a.Offset(, 3).Value, a.Offset(, 4).Value, a.Offset(, 6).Value)
  6.   Next
  7. End With
  8. With Workbooks("2.xls").Sheets(5)
  9.   For Each a In .Range(.[B2], .[B65536].End(xlUp))
  10.    a.Offset(, 1).Resize(, 3).Value = d(a & "")
  11.   Next
  12. End With
  13. End Sub
複製代碼
學海無涯_不恥下問

TOP

        靜思自在 : 手心向下是助人，手心向上是求人；助人快樂，求人痛苦。
返回列表 上一主題