Board logo

標題: 資料比較排序分類 [打印本頁]
作者: oak0723-1    時間: 2017-3-19 17:38     標題: 資料比較排序分類

各位老師好
有兩組資料,
想依編號由大至小排序,當編號相同則並列,若編號不同則分列
並將該編號後資料依級距合計,並計算筆數
如附件
不知如何用vb處理
還煩請解惑
謝謝
作者: Kubi    時間: 2017-3-21 16:22

回復 1# oak0723-1
沒有餵太多資料來Debug，不知是否藏有Bug。
還有附檔用掉太多變數才能竟功，看看其他先進是否有更佳的寫法。
[attach]26835[/attach]
作者: oak0723-1    時間: 2017-3-22 17:48     標題: 流水帳換算為分類帳

各位老師好
有一流水帳想轉換為分類帳,並區分級距(如附件)
希望有老師不吝願意幫忙小弟
感恩
謝謝
作者: oak0723-1    時間: 2017-3-22 17:51

謝謝
kubi老師願意幫忙小第
這個vb確實是小弟所須
謝謝
小弟有另一個問題是流水帳換算為分類帳http://forum.twbts.com/viewthread.php?tid=19437&extra=
若kubi老師不嫌棄的話
能繼續幫忙小弟
謝謝
感恩
作者: 准提部林    時間: 2017-3-22 22:17

軟著陸---利用H欄排序:
[attach]26851[/attach]
作者: oak0723-1    時間: 2017-3-23 20:21

謝謝准提部林老師不吝幫忙
也希望老幫忙解小弟一個問題「流水帳換算為分類帳」http://forum.twbts.com/viewthread.php?tid=19437&extra=
謝謝
作者: Kubi    時間: 2017-3-24 14:45

回復 1# oak0723-1
請教版大：
貼圖範本內的級距，含與不含的位置是否有誤？
作者: oak0723-1    時間: 2017-3-24 15:02

Kubi老師謝謝你關注我這個問題
我已更正我的級距涵與不含內容
請參閱(如附件)
作者: 准提部林    時間: 2017-3-25 10:52

回復 6# oak0723-1


  1. Sub TEST()
  2. Dim i&, R&, C&, Arr, Brr, xD, V, U
  3. Call Clear_All
  4. Arr = Range("A8:D" & Cells(Rows.Count, 1).End(xlUp).Row)
  5. Set xD = CreateObject("Scripting.Dictionary")
  6. For i = 1 To UBound(Arr): xD(Arr(i, 2)) = "": Next i
  7. U = xD.Count
  8. For i = 1 To U
  9. V = Application.Large(xD.keys, i)
  10. xD(V) = i * 8 - 7: [i6].Cells(1, xD(V)) = V
  11. Next i

  13. R = Cells(Rows.Count, "H").End(xlUp).Row - 10
  14. If R <= 0 Then Exit Sub
  15. Brr = [H11].Resize(R)
  16. For i = 1 To R: xD(Brr(i, 1)) = i: Next i

  18. ReDim Brr(1 To R, 1 To U * 8)

  20. For i = 1 To UBound(Arr)
  21. R = xD(Arr(i, 1)): C = xD(Arr(i, 2)): If R = 0 Or C = 0 Then GoTo 101

  23. V = Arr(i, 3)
  24. If V >= [I9] And V < [K9] Then Brr(R, C + 0) = Brr(R, C + 0) + V: Brr(R, C + 1) = Brr(R, C + 1) + 1
  25. If V >= [M9] And V < [O9] Then Brr(R, C + 4) = Brr(R, C + 4) + V: Brr(R, C + 5) = Brr(R, C + 5) + 1

  27. V = Arr(i, 4)
  28. If V >= [I9] And V < [K9] Then Brr(R, C + 2) = Brr(R, C + 2) + V: Brr(R, C + 3) = Brr(R, C + 3) + 1
  29. If V >= [M9] And V < [O9] Then Brr(R, C + 6) = Brr(R, C + 6) + V: Brr(R, C + 7) = Brr(R, C + 7) + 1
  30. 101: Next i

  32. [i11].Resize(UBound(Brr), UBound(Brr, 2)) = Brr
  33. End Sub
複製代碼



[attach]26886[/attach]
作者: oak0723-1    時間: 2017-3-25 15:49

謝謝准提部林老師的幫忙
只是小弟在執行時發現
若資料輸入的資料輸入不連續就會有錯誤產生
小弟希望當所輸入的資料雖非連續資料但也可以執行
希望有哪位老師能繼續幫小弟的忙
感恩
作者: 准提部林    時間: 2017-3-25 16:03

回復 10# oak0723-1


For i = 1 To UBound(Arr): xD(Arr(i, 2)) = "": Next i

改為:
For i = 1 To UBound(Arr)
    If IsNumeric(Arr(i, 2) & "") Then xD(Arr(i, 2)) = ""
Next i
作者: oak0723-1    時間: 2017-3-25 17:11

感恩
謝謝准提部林老師幫忙
謝謝
感恩



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