返回列表 上一主題 發帖

原資料如何用字典拆分，入不連續的欄位

n7822123
　暱稱: 阿龍

中學生Rank: 2

帖子
406 
主題
8 
精華
0 
積分
453 
點名
0  
作業系統
WINDOWS 7 
軟體版本
2007 
閱讀權限
20 
性別
男 
來自
台灣 
註冊時間
2015-2-7 
最後登錄
2021-7-31 
1# 跳轉到 »
發表於 2018-9-29 03:17 | 顯示全部帖子
本帖最後由 n7822123 於 2018-9-29 03:29 編輯

回復 4# s7659109

我寫的比較長一些，但是更有"彈性"，學號不連續也無所謂
  1. Sub test()
  2. Dim tt$, Rn&, Cn&, Ri&, Ci&
  3. Dim 資料範圍 As Range, 填寫範圍 As Range
  4. Set d = CreateObject("scripting.dictionary")
  5. Sheets("data").Activate
  6. Rn = Cells(Rows.Count, 1).End(xlUp).Row
  7. Cn = Cells(1, Columns.Count).End(xlToLeft).Column
  8. Set 資料範圍 = [b2].Resize(Rn - 1, Cn - 1)
  9. '輸入資料到字典
  10. For Each rg In 資料範圍
  11.   tt = Cells(1, rg.Column).Value
  12.   tt = tt & "," & Cells(rg.Row, 1).Value
  13.   d(tt) = rg.Value
  14. Next
  15. '==========我是分格線==========
  16. Sheets("test").Activate
  17. Ri = Cells(Rows.Count, 1).End(xlUp).Row
  18. Ci = Cells(1, Columns.Count).End(xlToLeft).Column
  19. Set 填寫範圍 = [b2].Resize(Ri - 1, Ci - 1)
  20. '從字典輸出資料
  21. For Each rg In 填寫範圍
  22.   tt = Cells(1, rg.Column).Value
  23.   tt = tt & "," & Cells(rg.Row, 1).Value
  24.   rg.Value = d(tt)
  25. Next
  26. End Sub
複製代碼
使用数组和字典1070929.rar (13.22 KB)
程式是依需求寫的，需求表達不清楚
或者沒有上傳附件，愛莫能助

TOP

n7822123
　暱稱: 阿龍

中學生Rank: 2

帖子
406 
主題
8 
精華
0 
積分
453 
點名
0  
作業系統
WINDOWS 7 
軟體版本
2007 
閱讀權限
20 
性別
男 
來自
台灣 
註冊時間
2015-2-7 
最後登錄
2021-7-31 
2#
發表於 2018-9-29 03:40 | 顯示全部帖子
本帖最後由 n7822123 於 2018-9-29 03:43 編輯

回復 5# n7822123

長歸長，但是應該很好理解
因為你的檔案是新版的".xlsm"，
不然準大應該早就回你了，

這裡很多高手都還在用舊版excel，
下次要快點得到答案時，建議上傳的檔案用".xls"
以上是心得分享
:D

另存舊版excel 如下，這樣就有更多人加入討論!
使用数组和字典1070929.rar (8.73 KB)
程式是依需求寫的，需求表達不清楚
或者沒有上傳附件，愛莫能助

TOP

n7822123
　暱稱: 阿龍

中學生Rank: 2

帖子
406 
主題
8 
精華
0 
積分
453 
點名
0  
作業系統
WINDOWS 7 
軟體版本
2007 
閱讀權限
20 
性別
男 
來自
台灣 
註冊時間
2015-2-7 
最後登錄
2021-7-31 
3#
發表於 2018-10-2 22:22 | 顯示全部帖子
本帖最後由 n7822123 於 2018-10-2 22:33 編輯

回復 13# s7659109


   來源資料與要貼入的資料，需要建立1-1對應關係

   如果沒有規律的話，應該是沒辦法用變數取代的

  除非要寫判斷式找出2個工作表的對應關係，這樣就跟你的命題:不需判斷衝突了。
程式是依需求寫的，需求表達不清楚
或者沒有上傳附件，愛莫能助

TOP

n7822123
　暱稱: 阿龍

中學生Rank: 2

帖子
406 
主題
8 
精華
0 
積分
453 
點名
0  
作業系統
WINDOWS 7 
軟體版本
2007 
閱讀權限
20 
性別
男 
來自
台灣 
註冊時間
2015-2-7 
最後登錄
2021-7-31 
4#
發表於 2018-10-2 23:10 | 顯示全部帖子
本帖最後由 n7822123 於 2018-10-2 23:25 編輯

回復 14# n7822123


靈光一閃，這樣應該滿意了吧!?
程序:test2
  1. Sub test2()
  2. Set d = CreateObject("scripting.dictionary")
  3. Dim Rn&, Cn&, arr
  4. Sheets("data").Activate
  5. Rn = Sheet2.Cells(Rows.Count, 1).End(xlUp).Row
  6. Cn = Cells(1, Columns.Count).End(xlToLeft).Column
  7. For C = 2 To Cn: d(Cells(1, C).Value) = Cells(2, C).Resize(Rn - 1, 1): Next C
  8. Sheets("test").Activate: Cn = Cells(1, Columns.Count).End(xlToLeft).Column
  9. For C = 2 To Cn: Cells(2, C).Resize(Rn - 1, 1) = d(Cells(1, C).Value): Next C
  10. End Sub
複製代碼
使用数组和字典1071002+.rar (12.29 KB)
程式是依需求寫的，需求表達不清楚
或者沒有上傳附件，愛莫能助

TOP

n7822123
　暱稱: 阿龍

中學生Rank: 2

帖子
406 
主題
8 
精華
0 
積分
453 
點名
0  
作業系統
WINDOWS 7 
軟體版本
2007 
閱讀權限
20 
性別
男 
來自
台灣 
註冊時間
2015-2-7 
最後登錄
2021-7-31 
5#
發表於 2018-10-4 01:18 | 顯示全部帖子
本帖最後由 n7822123 於 2018-10-4 01:33 編輯

回復 16# s7659109


請使用你附件裡面的 "test2"程序!

test1 與 test2 都可以符合你的需求，不同寫法
test1 最彈性，學號也不連續也可以!

sheet2.test 程序是你自己原本的!
有點無言.....

按Alt+F8
程式是依需求寫的，需求表達不清楚
或者沒有上傳附件，愛莫能助

TOP

n7822123
　暱稱: 阿龍

中學生Rank: 2

帖子
406 
主題
8 
精華
0 
積分
453 
點名
0  
作業系統
WINDOWS 7 
軟體版本
2007 
閱讀權限
20 
性別
男 
來自
台灣 
註冊時間
2015-2-7 
最後登錄
2021-7-31 
6#
發表於 2018-10-4 11:23 | 顯示全部帖子
本帖最後由 n7822123 於 2018-10-4 11:25 編輯

回復 18# s7659109

應該不是當了，3萬筆要執行一段時間!
字典物件的key輸入字串型態可提升速度(這也是跟準大學習的)
test1 不需修改
程序 test2修改如下

Sub test2()
Set d = CreateObject("scripting.dictionary")
Dim Rn&, Cn&, arr, tt$
Sheets("data").Activate
Rn = Sheet2.Cells(Rows.Count, 1).End(xlUp).Row
Cn = Cells(1, Columns.Count).End(xlToLeft).Column
For C = 2 To Cn
  tt = Cells(1, C).Value
  d(tt) = Cells(2, C).Resize(Rn - 1, 1)
Next C
Sheets("test").Activate
Cn = Cells(1, Columns.Count).End(xlToLeft).Column
For C = 2 To Cn
  tt = Cells(1, C).Value
  Cells(2, C).Resize(Rn - 1, 1) = d(tt)
Next C
End Sub

使用数组和字典1071004.rar (8.64 KB)
程式是依需求寫的，需求表達不清楚
或者沒有上傳附件，愛莫能助

TOP

        靜思自在 : 自己害自己，莫過於亂發脾氣。
返回列表 上一主題