Board logo

標題: [發問] 資料排列問題 [打印本頁]
作者: sandra_wang    時間: 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寫呢?
(我還是小學生沒辦法下載檔案，請大家多多指教!!)
作者: kimbal    時間: 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))

....

公式的方法也有很多,可以試試找找
作者: sandra_wang    時間: 2010-10-28 15:58

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

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

還是希望各位前輩可以再指導我一下，謝謝大家。
作者: oobird    時間: 2010-10-28 16:08

你應該po你的文件，想幫你的人才幫得上手。
難道你要別人參照你的圖去建個檔案？
作者: sandra_wang    時間: 2010-10-28 17:25

謝謝樓上的超級版主提醒!!
已經補上了!!
作者: Hsieh    時間: 2010-10-28 18:08

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

回復 5# sandra_wang
妳的範例的middle好像應該只有一筆才對
  1. Sub Ex()
  2. Dim A As Range, d As Object, Col As Integer, s As Long, r As Long, k As Integer, Mystr As String
  3. Dim ky As Variant
  4. Set d = CreateObject("Scripting.Dictionary")
  5. Set A = Range([M1], [M1].End(xlToRight))
  6. A.Resize(10, A.Count) = ""
  7. Col = 13
  8. For k = 8 To 10
  9. If Application.Count(Columns(k)) > 0 Then
  10.    For Each A In Columns(k).SpecialCells(xlCellTypeConstants, 1)
  11.       For i = 1 To A
  12.          s = s + 1
  13.          r = A.Row
  14.          Mystr = Replace(Cells(1, k), "數量", "_") & s
  15.          d(Mystr) = Application.Transpose(Cells(r, 2).Resize(, 4))
  16.       Next
  17.    Next
  18.    
  19.    For Each ky In d.keys
  20.       Cells(1, Col) = ky
  21.       Cells(3, Col).Resize(4, 1) = d(ky)
  22.       Col = Col + 1

  24.    Next
  25. End If
  26. s = 0: d.RemoveAll
  27. Next
  28. End Sub
複製代碼
作者: sandra_wang    時間: 2010-10-29 15:06

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

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

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

回復 8# sandra_wang
每一程序是依據,每各個案所量身訂製的 .不一定套用的上.
請要說明一下差異是在哪裡, 檔案是如此龐大我找得眼花也看不出來如何幫你.
第一個問題 另有一解請參考
  1. Sub Ex()
  2.     Dim Rng(1 To 2) As Range, i%, ii%, C%, T%, E
  3.     With Sheet1
  4.         .Range("M1", .Range("M1").End(xlToRight)).EntireColumn.Clear
  5.         Set Rng(1) = .Range("L3", .Range("L3").End(xlDown))
  6.         C = 1
  7.         For i = 8 To 10
  8.             T = 1   '欄位數量->歸零
  9.             For Each E In .Range(.Cells(1, i), .Cells(Rows.Count, i).End(xlUp)).SpecialCells(xlCellTypeConstants).Cells
  10.                 If Val(E) > 0 Then
  11.                     For ii = 1 To Val(E)
  12.                         Set Rng(2) = Rng(1).Offset(, C)
  13.                         .Cells(1, Rng(2).Column) = Replace(.Cells(1, i), "數量", "_" & T)
  14.                         Rng(2).Value = Application.Transpose(.Cells(E.Row, "b").Resize(, 4))
  15.                         Rng(2).Interior.ColorIndex = E.Interior.ColorIndex
  16.                         C = C + 1 '往右加1欄  Rng(1).Offset(, C)
  17.                         T = T + 1
  18.                     Next
  19.                 End If
  20.             Next
  21.         Next
  22.     End With
  23. End Sub
複製代碼
作者: Hsieh    時間: 2010-10-29 19:35

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

回復 8# sandra_wang
  1. Sub Ex()
  2. Dim A As Range
  3. Set d = CreateObject("Scripting.Dictionary")
  4. Set Rng = Range("CL2,CX2,DJ2")
  5. [ED2:EL65536] = ""
  6. r = 2
  7. For Each A In Rng
  8.    k = 135
  9.    For i = 7 To 9
  10.    s = 1
  11.       If Application.Count(A.Offset(, i).EntireColumn) > 0 Then
  12.       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)))
  13.          For Each b In A.Offset(, i).EntireColumn.SpecialCells(xlCellTypeConstants, 1)
  14.             For j = 1 To b
  15.                Mystr = Cells(3, b.Column) & "_" & s
  16.                s = s + 1
  17.                d(Mystr) = Application.Transpose(Cells(b.Row, A.Column + 1).Resize(, 4))
  18.             Next
  19.          Next
  20.          For Each ky In d.keys
  21.             Cells(r, k) = ky: Cells(r + 1, k).Resize(4, 1) = d(ky)
  22.             k = k + 1
  23.          Next
  24.          d.RemoveAll
  25.       End If
  26.       Next
  27.       r = r + 12
  28. Next
  29. End Sub
複製代碼
作者: sandra_wang    時間: 2010-11-4 09:48

謝謝#9 & #10你們的幫忙
作者: sandra_wang    時間: 2010-11-9 15:17

謝謝樓上兩位的回覆!!
感激~~



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