Karen asked in 電腦與網際網路軟體 · 1 decade ago

Access/Excel VBA問題:如何按群組將行轉為列

我有下列資料在Access中:

companyfirmlead

AX0

AY1

AZ0

BW1

BX0

(company,firm,lead)=(A,X,0) 依此類推....

我以company為群組並以遞減排序,lead以遞減排序,結果如下:

companyfirmlead

AY1

AX0

AZ0

BW1

BX0

最後想得到的資料格式如下:

AYXZ

BWX

就是以company為群組,lead為1的firm排在第一個,其他lead為0的firm排在後面,等於是把firm這欄行轉為列 。我覺得可能可以用VBA做出來,請問誰知道怎麼做?

Update:

我的資料是在access中,不知道VBA在excel跟access中是不是可以通用?希望是在access中可以用的VBA,如果大家只知道excel的也沒關係,請提供讓我試試看!感謝!

Update 2:

大流士 感謝您!請問您的程式是在excel或是 access中執行? 您有試過可以跑出結果嗎?

2 Answers

Rating
  • 1 decade ago
    Favorite Answer

    試過用TRANSFORM 方式,不能達到你的要求,必須要利用VBA了,方法如下:

    1.建立一資料表,名稱為"轉換",欄位任意設.

    2.做一表單,加一個按鈕名稱為"轉換",其ONCLICK的事件,程序如下:

    Private Sub 轉換_Click()

    Dim RS As Recordset

    Dim RS1 As Recordset

    Dim RS2 As Recordset

    Dim cat As New ADOX.Catalog

    Dim Tbl As ADOX.Table

    Dim RSAREA(65536) As String

    cat.ActiveConnection = CurrentProject.Connection

    Set RS = CurrentDb.OpenRecordset("select max(筆數) as 最大值 from (SELECT company, Count(company) AS 筆數 FROM 原始資料 GROUP BY company ) as 筆數查詢")

    a = RS![最大值] + 1

    Set Tbl = cat.Tables("轉換")

    For Each clm In Tbl.Columns

    SqlStr = "Alter table 轉換 drop column " & clm.Name

    CurrentProject.Connection.Execute SqlStr

    Next

    For i = 1 To a

    If i = 1 Then

    SqlStr = "Alter table 轉換 add column company Text"

    CurrentProject.Connection.Execute SqlStr

    Else

    SqlStr = "Alter table 轉換 add column " & i - 1 & " Text"

    CurrentProject.Connection.Execute SqlStr

    End If

    Next

    Set RS2 = CurrentDb.OpenRecordset("select * from 轉換")

    Set RS = CurrentDb.OpenRecordset("select company from 原始資料 group by company")

    b = RS.RecordCount

    RS.MoveFirst

    For k = 1 To b

    RSAREA(k) = RS![company]

    RS.MoveNext

    Next

    For k = 1 To b

    Set RS1 = CurrentDb.OpenRecordset("select * from 原始資料 where company='" & RSAREA(k) & "'")

    RS1.MoveFirst

    RS2.AddNew

    RS2![company] = RSAREA(k)

    For j = 1 To RS1.RecordCount

    RS2(j) = RS1![firm]

    RS1.MoveNext

    Next

    RS2.Update

    Next

    End Sub

    試試看!希望對你有幫助~

    2009-09-09 12:39:24 補充:

    在ACCESS中執行,此段程式已經過設測OK!確實可以達到你的要求喔~

  • Anonymous
    1 decade ago

    資料在 EXCEL 中的解嗎 ?

Still have questions? Get your answers by asking now.