返回列表 上一主題 發帖

[發問] 按分類編總號的迴圈要如何寫?

asch2007

帖子
15 
主題
4 
精華
0 
積分
25 
點名
0  
作業系統
win 7 
軟體版本
office 2010 
閱讀權限
10 
性別
男 
註冊時間
2013-8-7 
最後登錄
2016-7-6 

論壇贊助勳章
1# 跳轉到 » 倒序看帖
打印
tT
發表於 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
收藏 分享
123

GBKEE

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

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
2#
發表於 2013-9-12 15:19 | 只看該作者
本帖最後由 GBKEE 於 2013-9-12 15:21 編輯

回復 1# asch2007

可修改這裡的程式碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

asch2007

帖子
15 
主題
4 
精華
0 
積分
25 
點名
0  
作業系統
win 7 
軟體版本
office 2010 
閱讀權限
10 
性別
男 
註冊時間
2013-8-7 
最後登錄
2016-7-6 

論壇贊助勳章
3#
發表於 2013-9-12 16:10 | 只看該作者
回復 2# GBKEE


下載研究
先感謝回覆
123

TOP

asch2007

帖子
15 
主題
4 
精華
0 
積分
25 
點名
0  
作業系統
win 7 
軟體版本
office 2010 
閱讀權限
10 
性別
男 
註冊時間
2013-8-7 
最後登錄
2016-7-6 

論壇贊助勳章
4#
發表於 2013-9-12 16:21 | 只看該作者
回復 2# GBKEE
大大，對不起，沒說清楚，我要的不是合併兩欄
而是要按分類來編號，編完就會出現問題上所貼的結果

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

拜託了，謝謝
123

TOP

GBKEE

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

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
5#
發表於 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
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

asch2007

帖子
15 
主題
4 
精華
0 
積分
25 
點名
0  
作業系統
win 7 
軟體版本
office 2010 
閱讀權限
10 
性別
男 
註冊時間
2013-8-7 
最後登錄
2016-7-6 

論壇贊助勳章
6#
發表於 2013-9-12 18:33 | 只看該作者
回復 5# GBKEE

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

再次感謝
123

TOP

GBKEE

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

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
7#
發表於 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
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

asch2007

帖子
15 
主題
4 
精華
0 
積分
25 
點名
0  
作業系統
win 7 
軟體版本
office 2010 
閱讀權限
10 
性別
男 
註冊時間
2013-8-7 
最後登錄
2016-7-6 

論壇贊助勳章
8#
發表於 2013-9-13 10:12 | 只看該作者
回復 7# GBKEE

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

再次感謝
123

TOP

ML089

帖子
2025 
主題
13 
精華
0 
積分
2053 
點名
0  
作業系統
WIN7 
軟體版本
Office2007 
閱讀權限
100 
性別
男 
來自
台北市 
註冊時間
2011-3-2 
最後登錄
2024-3-14 

論壇榮譽勳章論壇贊助勳章熱烈參與勳章2014馬年全勤獎章2015羊年全勤獎章2016猴年全勤獎章
9#
發表於 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(  時，後面程式碼要如何改，可否示範一下。
{...} 表示需要用 CTRL+SHIFT+ENTER 三鍵輸入公式

TOP

GBKEE

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

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
10#
發表於 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( ,若不用是何意思.
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

        靜思自在 : 站在半路，比走到目標更辛苦。
返回列表 上一主題