Board logo

標題: [發問] 按分類編總號的迴圈要如何寫? [打印本頁]
作者: asch2007    時間: 2013-9-12 14:16     標題: 按分類編總號的迴圈要如何寫?

本帖最後由 GBKEE 於 2013-9-12 14:27 編輯

各位大大請問,我需要把各分類號編成總號,請問要如何用VBA執行?
分類號(經過簡化，實際上各分類數目很多)如下:
分類1        分類2        分類3
A01        B1        C1
A02        B2        C2
A03        B3       
        B4       


結果如下
分類1        分類2        分類3        編碼
A01        B1        C1        A01B1C1
A02        B1        C1        A02B1C1
A03        B1        C1        A03B1C1
A01        B2        C1        A01B2C1
A02        B2        C1        A02B2C1
A03        B2        C1        A03B2C1
A01        B3        C1        A01B3C1
A02        B3        C1        A02B3C1
A03        B3        C1        A03B3C1
A01        B4        C1        A01B4C1
A02        B4        C1        A02B4C1
A03        B4        C1        A03B4C1
A01        B1        C2        A01B1C2
A02        B1        C2        A02B1C2
A03        B1        C2        A03B1C2
A01        B2        C2        A01B2C2
A02        B2        C2        A02B2C2
A03        B2        C2        A03B2C2
A01        B3        C2        A01B3C2
A02        B3        C2        A02B3C2
A03        B3        C2        A03B3C2
A01        B4        C2        A01B4C2
A02        B4        C2        A02B4C2
A03        B4        C2        A03B4C2
作者: GBKEE    時間: 2013-9-12 15:19

本帖最後由 GBKEE 於 2013-9-12 15:21 編輯

回復 1# asch2007

可修改這裡的程式碼
作者: asch2007    時間: 2013-9-12 16:10

回復 2# GBKEE


下載研究
先感謝回覆
作者: asch2007    時間: 2013-9-12 16:21

回復 2# GBKEE
大大，對不起，沒說清楚，我要的不是合併兩欄
而是要按分類來編號，編完就會出現問題上所貼的結果

編號數會有3*4*2個，而且完全沒有重覆

拜託了，謝謝
作者: GBKEE    時間: 2013-9-12 17:21

回復 4# asch2007
試試看
  1. Option Explicit
  2. Sub Ex()
  3.     Dim AR(), AB(), x As Integer, x0 As Integer, x21 As Integer, x2 As Integer
  4.     AR = Array(Array("A01", "A02", "A03"), Array("B1", "B2", "B3", "B4"), Array("C1", "C2"))
  5.     For x0 = 0 To UBound(AR(0))
  6.         For x1 = 0 To UBound(AR(1))
  7.             For x2 = 0 To UBound(AR(2))
  8.                 ReDim Preserve AB(0 To x)
  9.                 AB(x) = AR(0)(x0) & AR(1)(x1) & AR(2)(x2)
  10.                 x = x + 1
  11.             Next
  12.         Next
  13.     Next
  14.     MsgBox Join(AB, vbLf)
  15. End Sub
複製代碼
作者: asch2007    時間: 2013-9-12 18:33

回復 5# GBKEE

再度感謝大大的回覆
但實際上每個分類少則幾十個，多則幾百個
能否有其他更有彈性的設定？

再次感謝
作者: GBKEE    時間: 2013-9-12 20:29

回復 6# asch2007
  1. Option Explicit
  2. Sub Ex()
  3.     Dim AR(1 To 3), AB(), x As Integer, x0 As Integer, x1 As Integer, x2 As Integer
  4.     With Sheet1
  5.         AR(1) = Application.Transpose(.Range("a1", .Range("a1").End(xlDown)))   'A欗   每個分類少則幾十個，多則幾百個
  6.         AR(2) = Application.Transpose(.Range("b1", .Range("b1").End(xlDown)))   'B欗
  7.         AR(3) = Application.Transpose(.Range("c1", .Range("c1").End(xlDown)))   'C欗

  9.         For x0 = 1 To UBound(AR(1))
  10.             For x1 = 1 To UBound(AR(2))
  11.                 For x2 = 1 To UBound(AR(3))
  12.                     ReDim Preserve AB(0 To x)
  13.                     AB(x) = AR(1)(x0) & AR(2)(x1) & AR(3)(x2)
  14.                     x = x + 1
  15.                 Next
  16.             Next
  17.         Next
  18.     End With
  19.     MsgBox Join(AB, vbTab)
  20. End Sub
複製代碼
作者: asch2007    時間: 2013-9-13 10:12

回復 7# GBKEE

感恩
這離我想要的很接近了
我再來研究要如何改

再次感謝
作者: ML089    時間: 2013-9-13 11:41

回復 7# GBKEE

AR(1) = Application.Transpose(.Range("a1", .Range("a1").End(xlDown)))   'A欗
AR(2) = Application.Transpose(.Range("b1", .Range("b1").End(xlDown)))   'B欗
AR(3) = Application.Transpose(.Range("c1", .Range("c1").End(xlDown)))   'C欗

請問若不用  Application.Transpose(  時，後面程式碼要如何改，可否示範一下。
作者: GBKEE    時間: 2013-9-13 14:26

回復 9# ML089
Application.Transpose =>工作表上使用貼上(轉置)的功能, 例: Application.Transpose(AR(1 To 5, 1 To 10)) 轉置為 AR(1 To 10 , 1 To 5 )
.Range("a1", .Range("a1").End(xlDown))=>二維陣列
因這裡AR(1)的元素,是設計為要置入一維陣列,不知你說的,Application.Transpose( ,若不用是何意思.



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