帖子: 31
主題: 10
精華: 0
積分: 49
點名: 0
作業系統: xp
軟體版本: office2003
閱讀權限: 10
性別: 女
註冊時間: 2010-10-27
最後登錄: 2011-10-14

1^# 跳轉到 » 倒序看帖

字體大小: tT

發表於 2010-10-27 16:04 | 只看該作者

[發問] 資料排列問題

本帖最後由 sandra_wang 於 2010-10-29 15:28 編輯

想請教各位前輩~
(請大家幫我看看附件)
我要如何把左邊的資料依照Max數量,Min數量,Middle數量把資料從左邊排列到右邊?
排列的規則是從H欄位開始，只要H欄位不是0的就要把欄位B~E的資料填到右邊表格
H欄位數量如果是"1"，右邊表格就填入一次，數量如果是"2"，右邊表格就填入2次，依此類推...

H欄位的部份處理完，接著換I欄位的部份，
I欄位數量如果是"1"，右邊表格就填入一次，數量如果是"2"，右邊表格就填入2次，依此類推…

最後是J欄位的部份，
J欄位數量如果是"1"，右邊表格就填入一次，數量如果是"2"，右邊表格就填入2次，依此類推…

還有右邊表格的表頭也要有讓它自動跑出來Max_1, Max_2,...

拜託大家幫幫我看看要怎麼用VBA寫呢?
(我還是小學生沒辦法下載檔案，請大家多多指教!!)

2010-10-27 下午 03-59-58.jpg (146.17 KB)

我的問題

問題.zip (4.58 KB)

我的Excel檔案

我的問題part2.zip (345.93 KB)

我的問題part2

樓主熱帖

kimbal

版主 Rank: 7 Rank: 7 Rank: 7

帖子: 472
主題: 5
精華: 0
積分: 485
點名: 0
作業系統: Windows
軟體版本: MS Office
閱讀權限: 100
性別: 男
來自: 香港
註冊時間: 2010-7-4
最後登錄: 2014-12-28

論壇貢獻勳章

2^#

發表於 2010-10-28 00:05 | 只看該作者

其實這個不一定要用VBA
如果MAX,MIDDLE,MIN下數字沒重覆可以用公式得出
M3=INDIRECT("B"&MATCH(1,H:H,0))
M4=INDIRECT("C"&MATCH(1,H:H,0))
M5=INDIRECT("D"&MATCH(1,H:H,0))
M6=INDIRECT("E"&MATCH(1,H:H,0))

N3=INDIRECT("B"&MATCH(2,H:H,0))
N4=INDIRECT("C"&MATCH(2,H:H,0))
N5=INDIRECT("D"&MATCH(2,H:H,0))
N6=INDIRECT("E"&MATCH(2,H:H,0))

....

公式的方法也有很多,可以試試找找

懂得發問,答案就會在其中

今日の一秒は明日にない
http://kimbalko-chi.blogspot.com
http://kimbalko.blogspot.com

TOP

sandra_wang

小學生 Rank: 1

帖子: 31
主題: 10
精華: 0
積分: 49
點名: 0
作業系統: xp
軟體版本: office2003
閱讀權限: 10
性別: 女
註冊時間: 2010-10-27
最後登錄: 2011-10-14

3^#

發表於 2010-10-28 15:58 | 只看該作者

感謝版主的回答~~
但是欄位B-欄位J 的資料會一直變化，每次進來的資料都不同，所以沒辦法用INDIRECT去比對。

因為每次進來的資料欄位H-J的數量都不一定，只要不是零的時候，就要把那列的資料填到右邊表格，
而且數量是多少，那筆資料就要出現幾次，

還是希望各位前輩可以再指導我一下，謝謝大家。

TOP

oobird

　頭銜: 街友一族

超級版主 Rank: 8 Rank: 8

帖子: 1572
主題: 16
精華: 2
積分: 1521
點名: 0
作業系統: xp
軟體版本: office 2003
閱讀權限: 150
性別: 男
註冊時間: 2010-5-1
最後登錄: 2016-1-13

論壇貢獻勳章

4^#

發表於 2010-10-28 16:08 | 只看該作者

你應該po你的文件，想幫你的人才幫得上手。
難道你要別人參照你的圖去建個檔案？

TOP

sandra_wang

小學生 Rank: 1

帖子: 31
主題: 10
精華: 0
積分: 49
點名: 0
作業系統: xp
軟體版本: office2003
閱讀權限: 10
性別: 女
註冊時間: 2010-10-27
最後登錄: 2011-10-14

5^#

發表於 2010-10-28 17:25 | 只看該作者

謝謝樓上的超級版主提醒!!
已經補上了!!

TOP

Hsieh

超級版主 Rank: 8 Rank: 8

帖子: 4901
主題: 44
精華: 24
積分: 4916
點名: 41
作業系統: Windows 7
軟體版本: Office 20xx
閱讀權限: 150
性別: 男
來自: 台北
註冊時間: 2010-4-30
最後登錄: 2025-2-16

2024年全勤獎章 2023年全勤獎章 2022虎年全勤獎章 2021牛年全勤獎章 2020鼠年全勤獎章 2019 豬年全勤獎章 2018 狗年全勤獎章 2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱心公益勳章 2011兔年全勤獎章

6^#

發表於 2010-10-28 18:08 | 只看該作者

本帖最後由 Hsieh 於 2010-10-28 19:56 編輯

回復 5# sandra_wang
妳的範例的middle好像應該只有一筆才對

Sub Ex()
Dim A As Range, d As Object, Col As Integer, s As Long, r As Long, k As Integer, Mystr As String
Dim ky As Variant
Set d = CreateObject("Scripting.Dictionary")
Set A = Range([M1], [M1].End(xlToRight))
A.Resize(10, A.Count) = ""
Col = 13
For k = 8 To 10
If Application.Count(Columns(k)) > 0 Then
For Each A In Columns(k).SpecialCells(xlCellTypeConstants, 1)
For i = 1 To A
s = s + 1
r = A.Row
Mystr = Replace(Cells(1, k), "數量", "_") & s
d(Mystr) = Application.Transpose(Cells(r, 2).Resize(, 4))
Next
Next
For Each ky In d.keys
Cells(1, Col) = ky
Cells(3, Col).Resize(4, 1) = d(ky)
Col = Col + 1
Next
End If
s = 0: d.RemoveAll
Next
End Sub

複製代碼

學海無涯_不恥下問

TOP

sandra_wang

小學生 Rank: 1

帖子: 31
主題: 10
精華: 0
積分: 49
點名: 0
作業系統: xp
軟體版本: office2003
閱讀權限: 10
性別: 女
註冊時間: 2010-10-27
最後登錄: 2011-10-14

7^#

發表於 2010-10-29 15:06 | 只看該作者

回覆#6 Hsieh 超級版主~
謝謝你提供我這個答案，因為有些我還是看不是很懂，但是我自己有調整後再試了一下!

因為我有三種產品需要這樣的排列，CPU,HDD,Memory
但是我自己改過之後，CPU的排列我可以順利跑出來，可是HDD和Memory的部份就跑不出來，
可以請樓上的超級版主幫我看看我哪裡錯了嗎?(我改過的部分有用紅色的字體標示)
我有附上檔案，請幫我看"問題part2"的附件

TOP

sandra_wang

小學生 Rank: 1

帖子: 31
主題: 10
精華: 0
積分: 49
點名: 0
作業系統: xp
軟體版本: office2003
閱讀權限: 10
性別: 女
註冊時間: 2010-10-27
最後登錄: 2011-10-14

8^#

發表於 2010-10-29 15:30 | 只看該作者

回覆#6 Hsieh 超級版主~
可以請你幫看看"我的問題part2"，
我的CPU本來可以跑出來，現在Priority 3 & Vendor的資料又跑不出來了，會出現#N/A。
其他HDD&Memory的資料我要怎麼調整它才會跑到橘色跟淺綠藍色的位置呢?
謝謝你!!

TOP

GBKEE

超級版主 Rank: 8 Rank: 8

帖子: 5923
主題: 13
精華: 1
積分: 5986
點名: 0
作業系統: win10
軟體版本: Office 2010
閱讀權限: 150
性別: 男
來自: 台灣基隆
註冊時間: 2010-5-1
最後登錄: 2022-1-23

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

9^#

發表於 2010-10-29 17:09 | 只看該作者

回復 8# sandra_wang
每一程序是依據,每各個案所量身訂製的 .不一定套用的上.
請要說明一下差異是在哪裡, 檔案是如此龐大我找得眼花也看不出來如何幫你.
第一個問題另有一解請參考

Sub Ex()
Dim Rng(1 To 2) As Range, i%, ii%, C%, T%, E
With Sheet1
.Range("M1", .Range("M1").End(xlToRight)).EntireColumn.Clear
Set Rng(1) = .Range("L3", .Range("L3").End(xlDown))
C = 1
For i = 8 To 10
T = 1 '欄位數量->歸零
For Each E In .Range(.Cells(1, i), .Cells(Rows.Count, i).End(xlUp)).SpecialCells(xlCellTypeConstants).Cells
If Val(E) > 0 Then
For ii = 1 To Val(E)
Set Rng(2) = Rng(1).Offset(, C)
.Cells(1, Rng(2).Column) = Replace(.Cells(1, i), "數量", "_" & T)
Rng(2).Value = Application.Transpose(.Cells(E.Row, "b").Resize(, 4))
Rng(2).Interior.ColorIndex = E.Interior.ColorIndex
C = C + 1 '往右加1欄 Rng(1).Offset(, C)
T = T + 1
Next
End If
Next
Next
End With
End Sub

複製代碼

TOP

Hsieh

超級版主 Rank: 8 Rank: 8

帖子: 4901
主題: 44
精華: 24
積分: 4916
點名: 41
作業系統: Windows 7
軟體版本: Office 20xx
閱讀權限: 150
性別: 男
來自: 台北
註冊時間: 2010-4-30
最後登錄: 2025-2-16

2024年全勤獎章 2023年全勤獎章 2022虎年全勤獎章 2021牛年全勤獎章 2020鼠年全勤獎章 2019 豬年全勤獎章 2018 狗年全勤獎章 2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱心公益勳章 2011兔年全勤獎章

10^#

發表於 2010-10-29 19:35 | 只看該作者

本帖最後由 Hsieh 於 2010-10-29 19:37 編輯

回復 8# sandra_wang

Sub Ex()
Dim A As Range
Set d = CreateObject("Scripting.Dictionary")
Set Rng = Range("CL2,CX2,DJ2")
[ED2:EL65536] = ""
r = 2
For Each A In Rng
k = 135
For i = 7 To 9
s = 1
If Application.Count(A.Offset(, i).EntireColumn) > 0 Then
Cells(r, 134).Resize(5, 1) = Application.Transpose(Array(A, A.Offset(1, 1), A.Offset(1, 2), A.Offset(1, 3), A.Offset(1, 4)))
For Each b In A.Offset(, i).EntireColumn.SpecialCells(xlCellTypeConstants, 1)
For j = 1 To b
Mystr = Cells(3, b.Column) & "_" & s
s = s + 1
d(Mystr) = Application.Transpose(Cells(b.Row, A.Column + 1).Resize(, 4))
Next
Next
For Each ky In d.keys
Cells(r, k) = ky: Cells(r + 1, k).Resize(4, 1) = d(ky)
k = k + 1
Next
d.RemoveAll
End If
Next
r = r + 12
Next
End Sub

複製代碼

學海無涯_不恥下問

TOP