Board logo

標題: 請問如何將訂單原始資料轉成需要的? [打印本頁]
作者: gaishutsusuru    時間: 2019-3-24 23:41     標題: 請問如何將訂單原始資料轉成需要的?

[attach]30299[/attach]

大家好，這幾天查了許多資料，還是不能將資料轉好。想請問如何將A:E的資料，分別轉換成H:J 以及M到V呢? (如果大家在公式設定上，有更好的排列方式，也可以直接調整)

還煩情大家協助，謝謝。


附上EXCEL的檔案：
[attach]30300[/attach]
作者: hcm19522    時間: 2019-3-25 12:08

https://blog.xuite.net/hcm19522/twblog/587174675
作者: ikboy    時間: 2019-3-25 12:55

  1. Sub zz()
  2. Dim d As Object, a, k, t, b(), n&, m&, kk, tt
  3. Set d = CreateObject("scripting.dictionary")
  4. a = Range("a2:e" & [e1048576].End(3).Row)
  5. For i = 1 To UBound(a)
  6.     d("@" & a(i, 2)) = ""
  7.     k = a(i, 2) & "|" & a(i, 3)
  8.     If Not d.exists(k) Then
  9.         d(k) = Array(a(i, 4), a(i, 5), a(i, 5))
  10.     Else
  11.         t = d(k)
  12.         t(0) = t(0) & "|" & a(i, 4)
  13.         t(1) = t(1) & "|" & a(i, 5)
  14.         t(2) = t(2) + a(i, 5)
  15.         d(k) = t
  16.     End If
  17. Next
  18. k = Filter(d.keys, "@")
  19. ReDim b(1 To UBound(a), 1 To UBound(k) + 1)
  20. For j = 0 To UBound(k)
  21.     b(1, j + 1) = Mid(k(j), 2)
  22.     d.Remove (k(j))
  23.     kk = Filter(d.keys, b(1, j + 1) & "|")
  24.     For ii = 0 To UBound(kk)
  25.         t = d(kk(ii))
  26.         b(ii + 2, j + 1) = Split(kk(ii), "|")(1) & ":" & t(2)
  27.         m = m + 1
  28.         n = IIf(ii + 2 > n, ii + 2, n)
  29.     Next
  30. Next
  31. [h7].Resize(n, UBound(b, 2)) = b
  32. k = d.keys
  33. ReDim b(1 To UBound(a), 1 To m * 2): j = 0
  34. For i = 0 To UBound(k)
  35.     kk = Split(k(i), "|")
  36.     t = d(k(i))
  37.     j = j + 1
  38.     b(1, j) = kk(0)
  39.     b(2, j) = kk(1) & ":" & t(2)
  40.     For jj = 0 To 1
  41.         tt = Split(t(jj), "|")
  42.         For jjj = 0 To UBound(tt)
  43.             b(3 + jjj, j + jj) = tt(jjj)
  44.         Next
  45.     Next
  46.     n = IIf(jjj + 2 > n, jjj + 3, n)
  47.     j = j + 1
  48. Next
  49. [m7].Resize(n, UBound(b, 2)) = b
  50. Set d = Nothing
  51. End Sub
複製代碼
作者: gaishutsusuru    時間: 2019-6-18 18:50

回復 3# ikboy


ikboy大大，

謝謝您的協助。

在操作巨集的過程中，有一些小問題，想請教您：
1. 會出現如檔案所示的N/A
2. 將第五行的資料複製到第六行、第七行，會出現執行階段錯誤'9' 陣列索引超出範圍。
偵錯會在：b(3 + jjj, j + jj) = tt(jjj)

想請問如何解決呢，謝謝您的協助。

[attach]30896[/attach]
作者: ikboy    時間: 2019-6-20 17:29

  1. Sub zz()
  2. Dim d As Object, a, k, t, b(), n&, m&, kk, tt
  3. Set d = CreateObject("scripting.dictionary")
  4. a = Range("a2:e" & [e1048576].End(3).Row)
  5. For i = 1 To UBound(a)
  6.     d("@" & a(i, 2)) = ""
  7.     k = a(i, 2) & "|" & a(i, 3)
  8.     If Not d.exists(k) Then
  9.         d(k) = Array(a(i, 4), a(i, 5), a(i, 5))
  10.     Else
  11.         t = d(k)
  12.         t(0) = t(0) & "|" & a(i, 4)
  13.         t(1) = t(1) & "|" & a(i, 5)
  14.         t(2) = t(2) + a(i, 5)
  15.         d(k) = t
  16.     End If
  17. Next
  18. k = Filter(d.keys, "@")
  19. ReDim b(1 To UBound(a), 1 To UBound(k) + 1)
  20. For j = 0 To UBound(k)
  21.     b(1, j + 1) = Mid(k(j), 2)
  22.     d.Remove (k(j))
  23.     kk = Filter(d.keys, b(1, j + 1) & "|")
  24.     For ii = 0 To UBound(kk)
  25.         t = d(kk(ii))
  26.         b(ii + 2, j + 1) = Split(kk(ii), "|")(1) & ":" & t(2)
  27.         m = m + 1
  28.         n = IIf(ii + 2 > n, ii + 2, n)
  29.     Next
  30. Next
  31. [h1].Resize(n, UBound(b, 2)) = b
  32. k = d.keys
  33. ReDim b(1 To UBound(a), 1 To m * 2): j = 0
  34. For i = 0 To UBound(k)
  35.     kk = Split(k(i), "|")
  36.     t = d(k(i))
  37.     j = j + 1
  38.     b(1, j) = kk(0)
  39.     b(2, j) = kk(1) & ":" & t(2)
  40.     For jj = 0 To 1
  41.         tt = Split(t(jj), "|")
  42.         For jjj = 0 To UBound(tt)
  43.             b(3 + jjj, j + jj) = tt(jjj)
  44.             Cells(3 + jjj, j + jj + 12) = tt(jjj)
  45.         Next
  46.         n = IIf(UBound(tt) + 3 > n, UBound(tt) + 3, n)
  47.     Next
  48.     j = j + 1
  49. Next
  50. [m1].Resize(n, UBound(b, 2)) = b
  51. Set d = Nothing
  52. End Sub
複製代碼
作者: gaishutsusuru    時間: 2019-6-21 14:34

回復 5# ikboy

ikboy大大您好，
感謝您提供新的巨集，但經實測後，還是會有錯誤。如下圖：
[attach]30917[/attach]


不好意思，若您方便，還請麻煩您協助提供一些想法，謝謝您。
作者: 准提部林    時間: 2019-6-22 13:01

[批號]也做去重覆再加總:
[attach]30921[/attach]
作者: gaishutsusuru    時間: 2019-6-22 19:13

回復 7# 准提部林


謝謝准提部林大大提供的巨集寫法，在此想請教您：
如果想讓兩個表格分別從J1和J10的位置開始顯示的話，
"
[H1].Resize(MaxRa + 1, MaxCa) = Arr
[H1].Cells(1, MaxCa + 3).Resize(MaxRb + 2, MaxCb) = Brr
"
我改了上面的寫法，變成如下：
"
[J1].Resize(MaxRa + 1, MaxCa) = Arr
[J10].Cells(1, MaxCa - 2).Resize(MaxRb + 2, MaxCb) = Brr
"

但我發現，如果資料一變動的話，第二個表格不一定會從J10開始顯示。

想請問准提部林大大，該如何調整呢? 謝謝您。
作者: 准提部林    時間: 2019-6-22 19:19

回復 8# gaishutsusuru

[J1].Resize(MaxRa + 1, MaxCa) = Arr
[J1].Cells(MaxRa + 4, 1).Resize(MaxRb + 2, MaxCb) = Brr

上下空兩行~~
作者: gaishutsusuru    時間: 2019-6-23 11:36

回復 9# 准提部林


謝謝您的回覆。
在經過實測後，發現第二個表格是會隨著第一個表格的內容來空兩行。

不好意思，想請問您，可以讓第二個表格固定都從J10開始嗎？

再拜託您抽空協助想法，謝謝您。
作者: 准提部林    時間: 2019-6-23 12:36

回復 10# gaishutsusuru


如果表一超過10行, 又怎做???
作者: 准提部林    時間: 2019-6-23 12:43

回復 10# gaishutsusuru


With [J1].Resize(MaxRa + 1, MaxCa)
     .Value = Arr
     .Borders.LineStyle = 1
     .Rows(1).Interior.ColorIndex = 6
End With

Dim Erng As Range
Set Erng = [J1].Cells(MaxRa + 4, 1)
If Erng.Row < 10 Then Set Erng = [J10]
With Erng.Resize(MaxRb + 2, MaxCb)
     .Value = Brr
     .Borders.LineStyle = 1
     .Rows(1).Interior.ColorIndex = 6
End With
作者: gaishutsusuru    時間: 2019-6-23 15:18

回復 12# 准提部林


謝謝您的回覆

關於您提到的問題，對您非常不好意思，我沒有說明清楚：因為「大小最多只有6種尺寸」，所以表一最多會到J6，應該是不會到J10的。

剛剛試了您改的巨集，目前應該是可以操作了。

最後，真的感謝您的協助，謝謝。



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