返回列表 上一主題 發帖

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

FAlonso

帖子
135 
主題
19 
精華
0 
積分
165 
點名
0  
作業系統
XP 
軟體版本
2003 
閱讀權限
20 
性別
男 
來自
香港 
註冊時間
2010-12-9 
最後登錄
2012-8-27 
1# 跳轉到 »
發表於 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

        靜思自在 : 對父母要知恩，感恩、報恩。
返回列表 上一主題