麻辣家族討論版版 » Excel程式區 » 轉置詢問

返回列表下一主題上一主題發帖

[發問] 轉置詢問

小學生 Rank: 1

帖子: 10
主題: 3
精華: 0
積分: 15
點名: 0
作業系統: windows7
軟體版本: 2012
閱讀權限: 10
註冊時間: 2015-1-1
最後登錄: 2021-5-26

1^# 跳轉到 » 倒序看帖

字體大小: tT

發表於 2015-7-28 21:14 | 只看該作者

[發問] 轉置詢問

請問如果要將工作表1的資料轉置成工作表2的資料要如何編寫呢？謝謝！
1. 資料來源工作表1中的abc欄
2.以a欄為主查詢貼到工作表2，並將相同的資料往後貼在工作表2
a欄每筆資料數量不一定，甲有四筆，乙有十筆，…
3.顏色只是為了讓大家看得更清礎，並不需標示顏色

1.jpg (23.03 KB)

工作表1

11.png (6.57 KB)

工作表2

活頁簿1.zip (7.3 KB)

活頁簿1

樓主熱帖

收藏

中學生 Rank: 2

帖子: 41
主題: 0
精華: 0
積分: 79
點名: 0
作業系統: win7
軟體版本: 2010
閱讀權限: 20
性別: 男
註冊時間: 2014-4-1
最後登錄: 2016-2-17

2^#

發表於 2015-7-29 19:41 | 只看該作者

回復 1# dnadark

參考看看!!!

Sub test()
Dim arr: arr = Worksheets("工作表1").[c1:e15]
Dim i, j, k: i = 1: k = 2
With Worksheets("工作表2")
'.UsedRange.Clear
.Cells(1, 1) = arr(1, 1)
For j = 2 To 15
If arr(j, 1) <> arr(j - 1, 1) Then
i = i + 1: k = 2: j = j + 1: .Cells(i, 1) = arr(j, 1)
End If
.Cells(i, k) = arr(j, 2)
.Cells(i, k + 1) = arr(j, 3)
k = k + 2
Next j
End With
End Sub

複製代碼

小學生 Rank: 1

帖子: 10
主題: 3
精華: 0
積分: 15
點名: 0
作業系統: windows7
軟體版本: 2012
閱讀權限: 10
註冊時間: 2015-1-1
最後登錄: 2021-5-26

3^#

發表於 2015-7-30 12:04 | 只看該作者

測試沒有問題，謝謝no3-taco ~~~

靜思自在 : 盡多少本份，就得多少本事。

返回列表下一主題上一主題