Board logo

標題: [發問] 資料轉置(利用vba自動更新) [打印本頁]
作者: ciboybj    時間: 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    時間: 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
複製代碼
作者: ciboybj    時間: 2015-1-31 10:14

太感謝了!!
不好意思，如果您有空可以大概說明一下程式碼嗎?
謝謝~~~~~~~~



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