返回列表 上一主題 發帖

[發問] 資料轉置(利用vba自動更新)

ciboybj

帖子
47 
主題
19 
精華
0 
積分
82 
點名
0  
作業系統
win  
軟體版本
xp 
閱讀權限
20 
註冊時間
2014-7-4 
最後登錄
2021-9-4 
1# 跳轉到 » 倒序看帖
打印
tT
發表於 2015-1-29 13:12 | 只看該作者

[發問] 資料轉置(利用vba自動更新)

大家好
想請問大家以下資料轉置
該如何用vba完成

原始資料如下（sheet1)
第一欄    第二欄
    A            1
    A            2
    B            1
    B            2
    B            3
    C            1
轉置後呈現如下(sheet2)
第一欄    第二欄    第三欄
    A            B             C
    1            1              1
    2            2
                  3   

由於原始資料(sheet1)會不定期新增(例如於第一欄中加入A；第二欄中加入3)
因此希望可以透過vba
在sheet1新增資料後
按下vba製作的按鈕
可以直接在sheet2對應更新資料

謝謝∼
收藏 分享

luhpro

帖子
835 
主題
6 
精華
0 
積分
915 
點名
16  
作業系統
Win 10,7 
軟體版本
2019,2013,2003 
閱讀權限
50 
性別
男 
註冊時間
2010-5-3 
最後登錄
2024-11-14 
2#
發表於 2015-1-30 21:54 | 只看該作者
大家好
想請問大家以下資料轉置
該如何用vba完成

原始資料如下（sheet1)
第一欄    第二欄
    A    ...
ciboybj 發表於 2015-1-29 13:12
  1. Sub NN()
  2.   Dim iCol%
  3.   Dim lRows&
  4.   Dim sStr$
  5.   Dim vD, vRow
  6.   
  7.   Set vD = CreateObject("Scripting.Dictionary")
  8.   Set vRow = CreateObject("Scripting.Dictionary")
  9.   lRows = 1
  10.   iCol = 1
  11.   Sheets("Sheet2").Cells.Clear
  12.   With Sheets("Sheet1")
  13.     While .Cells(lRows, 1) <> ""
  14.       sStr = CStr(.Cells(lRows, 1))
  15.       If vD.Exists(sStr) Then
  16.         vRow(sStr) = vRow(sStr) + 1
  17.       Else
  18.         vD(sStr) = iCol
  19.         iCol = iCol + 1
  20.         vRow(sStr) = 1
  21.         Sheets("Sheet2").Cells(vRow(sStr), vD(sStr)) = .Cells(lRows, 1)
  22.         vRow(sStr) = vRow(sStr) + 1
  23.       End If
  24.       Sheets("Sheet2").Cells(vRow(sStr), vD(sStr)) = .Cells(lRows, 2)
  25.       lRows = lRows + 1
  26.     Wend
  27.   End With
  28. End Sub
複製代碼

TOP

ciboybj

帖子
47 
主題
19 
精華
0 
積分
82 
點名
0  
作業系統
win  
軟體版本
xp 
閱讀權限
20 
註冊時間
2014-7-4 
最後登錄
2021-9-4 
3#
發表於 2015-1-31 10:14 | 只看該作者
太感謝了!!
不好意思，如果您有空可以大概說明一下程式碼嗎?
謝謝~~~~~~~~

TOP

        靜思自在 : 君子如水，隨方就圓，無處不自在。
返回列表 上一主題