返回列表 上一主題 發帖

貼入製造號碼後自動於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)

收藏 分享

Hsieh

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

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

霸氣走全身
　暱稱: 加菲貓

中學生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

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 
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

Hsieh

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

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

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

        靜思自在 : 不要隨心所欲，要隨心教育自己。
返回列表 上一主題