返回列表 上一主題 發帖

貼入製造號碼後自動於G2產生填滿效果

霸氣走全身
　暱稱: 加菲貓

中學生Rank: 2

帖子
36 
主題
16 
精華
0 
積分
177 
點名
0  
作業系統
Xp 
軟體版本
offICE2003 
閱讀權限
20 
性別
女 
註冊時間
2010-8-23 
最後登錄
2021-7-20 
1# 跳轉到 » 正序看帖
打印
tT
發表於 2010-9-2 00:01 | 只看該作者

貼入製造號碼後自動於G2產生填滿效果

請問一下
貼入製造號碼後自動於G2產生填滿效果
10005874-1-6
於G2自動產生
10005874-1
10005874-2
10005874-3
10005874-4
10005874-5
10005874-6
是用函數還是巨集才可以呢
如附件
請幫忙~~~
謝謝

貼入後自動於G2產生填滿效果.rar (1.95 KB)

收藏 分享

FAlonso

帖子
135 
主題
19 
精華
0 
積分
165 
點名
0  
作業系統
XP 
軟體版本
2003 
閱讀權限
20 
性別
男 
來自
香港 
註冊時間
2010-12-9 
最後登錄
2012-8-27 
7#
發表於 2011-3-26 13:58 | 只看該作者
樓主1樓
  1. Sub abc()
  2. Dim head(), body(), tail(), mycell As Range, i As Integer, j As Integer, k As Integer
  3. For Each mycell In Range([c2], [c65536].End(xlUp))
  4. ReDim Preserve head(i)
  5. ReDim Preserve body(i)
  6. ReDim Preserve tail(i)
  7. head(i) = Split(mycell, "-")(0)
  8. body(i) = Split(mycell, "-")(1)
  9. tail(i) = Split(mycell, "-")(2)
  10. i = i + 1
  11. Next

  13. Range("h2").Activate

  15. For j = 0 To UBound(head)
  16. For k = body(j) To tail(j)
  17. ActiveCell.Value = head(j) & "-" & k
  18. ActiveCell.Offset(1).Activate
  19. Next
  20. Next

  22. End Sub
複製代碼
樓主5樓
  1. Sub myprint()
  2. Dim mycell As Range, head(), body(), tail(), BPnumber(), i As Integer
  3. Dim j As Integer, bp As Integer, k As Integer, l As Integer

  5. For Each mycell In Range([d2], [d65536].End(xlUp))
  6. ReDim Preserve head(i)
  7. ReDim Preserve body(i)
  8. ReDim Preserve tail(i)
  9. ReDim Preserve BPnumber(i)
  10. head(i) = Split(mycell, "-")(0)
  11. body(i) = Split(mycell, "-")(1)
  12.     If UBound(Split(mycell, "-")) = 2 Then
  13.     tail(i) = Split(mycell, "-")(2)
  14.     Else
  15.     tail(i) = ""
  16.     End If
  17. BPnumber(i) = mycell.Offset(, 1).Value
  18. i = i + 1
  19. Next

  21. Range("L2").Activate

  23. For j = 0 To UBound(head)
  24.     If tail(j) = "" Then
  25.         If BPnumber(j) = 1 Then
  26.         ActiveCell = Cells(j + 2, 2).Value
  27.         ActiveCell.Offset(, 1) = Cells(j + 2, 2).Offset(, 1).Value
  28.         ActiveCell.Offset(, 2) = head(j) & "-" & body(j)
  29.         ActiveCell.Offset(1).Activate
  30.         Else
  31.             For bp = 1 To BPnumber(j)
  32.                 ActiveCell = Cells(j + 2, 2).Value
  33.                 ActiveCell.Offset(, 1) = Cells(j + 2, 2).Offset(, 1).Value
  34.                 ActiveCell.Offset(, 2) = head(j) & "-" & body(j) & Chr(64 + bp)
  35.                 ActiveCell.Offset(1).Activate
  36.             Next
  37.         End If
  38.     Else
  39.         If BPnumber(j) = 1 Then
  40.             For k = body(j) To tail(j)
  41.                 ActiveCell = Cells(j + 2, 2).Value
  42.                 ActiveCell.Offset(, 1) = Cells(j + 2, 2).Offset(, 1).Value
  43.                 ActiveCell.Offset(, 2) = head(j) & "-" & k
  44.                 ActiveCell.Offset(1).Activate
  45.             Next
  46.         Else
  47.             For k = body(j) To tail(j)
  48.                 For bp = 1 To BPnumber(j)
  49.                  ActiveCell = Cells(j + 2, 2).Value
  50.                  ActiveCell.Offset(, 1) = Cells(j + 2, 2).Offset(, 1).Value
  51.                  ActiveCell.Offset(, 2) = head(j) & "-" & k & Chr(64 + bp)
  52.                  ActiveCell.Offset(1).Activate
  53.                  Next
  54.             Next
  55.         End If
  56.     End If
  57. Next

  59. End Sub
複製代碼
土法大煉鋼,比較繁複和慢一點
另外5樓附檔D7一欄,最右手面有多餘空格,會影響結果,要小心處理
80 字節以內
不支持自定義 Discuz! 代碼

TOP

Hsieh

帖子
4901 
主題
44 
精華
24 
積分
4916 
點名
254  
作業系統
Windows 7 
軟體版本
Office 20xx 
閱讀權限
150 
性別
男 
來自
台北 
註冊時間
2010-4-30 
最後登錄
2024-11-23 

2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
6#
發表於 2011-3-25 11:21 | 只看該作者
回復 5# 霸氣走全身
  1. Sub SSS()
  2. Dim Ay(), A As Range, Ar As Variant, s&, i%
  3. For Each A In Range([D2], [D65536].End(xlUp))
  4.    If Len(A) - Len(Replace(A, "-", "")) = 2 Then
  5.    Ar = Split(A, "-")
  6.    For i = Val(Ar(1)) To Val(Ar(2))
  7.    For j = 1 To A.Offset(, 1)
  8.    If A.Offset(, 1) > 1 Then temp = Chr(64 + j) Else temp = ""
  9.       ReDim Preserve Ay(s)
  10.       Ay(s) = Array(A.Offset(, -2).Value, A.Offset(, -1).Value, Ar(0) & "-" & i & temp)
  11.       s = s + 1
  12.    Next
  13.    Next
  14.    Else
  15.    For j = 1 To A.Offset(, 1)
  16.    If A.Offset(, 1) > 1 Then temp = Chr(64 + j) Else temp = ""
  17.       ReDim Preserve Ay(s)
  18.       Ay(s) = Array(A.Offset(, -2).Value, A.Offset(, -1).Value, A.Value & temp)
  19.       s = s + 1
  20.    Next
  21.    End If
  22. Next
  23. [K2:M65536] = ""
  24. [K2].Resize(s, 3) = Application.Transpose(Application.Transpose(Ay))
  25. End Sub
複製代碼
學海無涯_不恥下問

TOP

霸氣走全身
　暱稱: 加菲貓

中學生Rank: 2

帖子
36 
主題
16 
精華
0 
積分
177 
點名
0  
作業系統
Xp 
軟體版本
offICE2003 
閱讀權限
20 
性別
女 
註冊時間
2010-8-23 
最後登錄
2021-7-20 
5#
發表於 2011-3-25 00:09 | 只看該作者
回復 2# Hsieh

請問你
如果是
客戶         尺寸     製造號碼            BP數
AAA        110*550        1009564-1         2
BBB        333*545        01006505-1-2        4
可以轉換成如下，BP數 2 轉換成2比同樣號碼，但是後面會以A~B區分~~BP數 4      會  A~B~C~D 區分              
AAA        110*550        1009564-1A
AAA        110*550        1009564-1B
BBB        333*545        01006505-1A
BBB        333*545        01006505-1B
BBB        333*545        01006505-1C
BBB        333*545        01006505-1D
BBB        333*545        01006505-2A
BBB        333*545        01006505-2B
BBB        333*545        01006505-2C
BBB        333*545        01006505-2D

這樣也可以嗎
再次麻煩妳了
謝謝

貼入後自動於G2產生填滿效果.rar (8.26 KB)

TOP

toomellowhaw

帖子
54 
主題
1 
精華
0 
積分
60 
點名
0  
作業系統
XP 
軟體版本
OFFICE 2003 
閱讀權限
20 
註冊時間
2010-6-27 
最後登錄
2016-11-4 
4#
發表於 2010-9-10 22:09 | 只看該作者
權限不足，無法下載你的檔案，所以暫時假定你的製造號碼貼在[G1]格內，那麼只要在[G2]格內輸入下列公式，再拖曳複製至所需列數即可....笨方法，請指教..
=IF(--(ROWS($2:2)+MID($G$1,FIND("-",$G$1)+1,FIND("-",$G$1,FIND("-",$G$1)+1)-FIND("-",$G$1)-1)-1)<=--RIGHT($G$1,LEN($G$1)-FIND("-",$G$1,FIND("-",$G$1)+1)),LEFT($G$1,FIND("-",$G$1)-1)&"-"&(ROWS($2:2)+MID($G$1,FIND("-",$G$1)+1,FIND("-",$G$1,FIND("-",$G$1)+1)-FIND("-",$G$1)-1)-1),"")

TOP

霸氣走全身
　暱稱: 加菲貓

中學生Rank: 2

帖子
36 
主題
16 
精華
0 
積分
177 
點名
0  
作業系統
Xp 
軟體版本
offICE2003 
閱讀權限
20 
性別
女 
註冊時間
2010-8-23 
最後登錄
2021-7-20 
3#
發表於 2010-9-5 09:54 | 只看該作者
回復 2# Hsieh


dear Hsieh
謝謝你喔~~
真的可以耶
^^

TOP

Hsieh

帖子
4901 
主題
44 
精華
24 
積分
4916 
點名
254  
作業系統
Windows 7 
軟體版本
Office 20xx 
閱讀權限
150 
性別
男 
來自
台北 
註冊時間
2010-4-30 
最後登錄
2024-11-23 

2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
2#
發表於 2010-9-2 08:48 | 只看該作者
  1. Sub getmynumber()
  2. Dim Ay(), A As Range, Ar As Variant, s&, i%
  3. For Each A In Range([C2], [C65536].End(xlUp))
  4.    If Len(A) - Len(Replace(A, "-", "")) = 2 Then
  5.    Ar = Split(A, "-")
  6.    For i = Val(Ar(1)) To Val(Ar(2))
  7.       ReDim Preserve Ay(s)
  8.       Ay(s) = Ar(0) & "-" & i
  9.       s = s + 1
  10.    Next
  11.    Else
  12.       ReDim Preserve Ay(s)
  13.       Ay(s) = A
  14.       s = s + 1
  15.    End If
  16. Next
  17. [G2:G65536] = ""
  18. [G2].Resize(s, 1) = Application.Transpose(Ay)
  19. End Sub
複製代碼
學海無涯_不恥下問

TOP

        靜思自在 : 口說好話、心想好意、身行好事。
返回列表 上一主題