返回列表 上一主題 發帖

請教版主及各位高手:如何在多個群組裡新增序號並自動進位?

cmo140497

帖子
95 
主題
29 
精華
0 
積分
150 
點名
0  
作業系統
windows2003 
軟體版本
office 2003 
閱讀權限
20 
性別
男 
來自
Kaoshiung 
註冊時間
2010-11-5 
最後登錄
2018-2-8 
1# 跳轉到 » 倒序看帖
打印
tT
發表於 2013-5-21 09:47 | 只看該作者

請教版主及各位高手:如何在多個群組裡新增序號並自動進位?

Dear 版主及各位高手:
小弟想如何在多個群組裡新增序號並自動搜尋指定群組的最後序號,並自動進位?
這些群組會在同一B欄裡,一組有6個位元,左起第1,2位元為週別Weeknum,左起第3,4位元為群組別,左起第5,6位元則為序號,分別為0~9~A~Z,當第6位元到Z時則自動進位第5位元+1



新增 Microsoft Excel 工作表.zip (18.74 KB)
收藏 分享

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-5-21 13:44 | 只看該作者
回復 1# cmo140497
你可以上傳對照於,新增序號,並自動進位,的範例.
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

cmo140497

帖子
95 
主題
29 
精華
0 
積分
150 
點名
0  
作業系統
windows2003 
軟體版本
office 2003 
閱讀權限
20 
性別
男 
來自
Kaoshiung 
註冊時間
2010-11-5 
最後登錄
2018-2-8 
3#
發表於 2013-5-21 14:13 | 只看該作者
回復 2# GBKEE


    不好意思,小弟大概寫了一段就只能根據最後一筆之資料作新增及序號之進位,後來想到因為數據中混雜很多不同群組,不同群組的起始序號均不同,
  1. Sub FindNewSeq()
  2. Dim lastStr$, r%, LAsc%, RAsc%, RChr$, LChr$, ThisWeekNm%
  3. '0~9:48~57
  4. 'A~Z:65~90
  5. With Sheets(1)
  6. r = .Range("C65536").End(xlUp).Row
  7. lastStr = .Cells(r, 3)
  8. ThisWeekNm = Application.WorksheetFunction.WeekNum(Date)
  9. If Len(lastStr) > 6 Or Len(lastStr) < 11 Then
  10.     response = MsgBox("請問是否增加子批:", 4, "提示")
  11.     If response = vbNo And Len(lastStr) = 6 Then
  12.     '無子批也不想增加子批
  13.         LAsc = Asc(Right(lastStr, 2))
  14.         RAsc = Asc(Right(lastStr, 1))
  15.         If RAsc < 57 And RAsc > 47 Then
  16.                 RAsc = RAsc + 1
  17.             ElseIf RAsc = 57 Then
  18.                 RAsc = RAsc + 8
  19.             ElseIf RAsc < 90 And RAsc > 65 Then
  20.                 RAsc = RAsc + 1
  21.             ElseIf RAsc = 90 Then
  22.                 LAsc = LAsc + 1
  23.                 RAsc = 48
  24.             Else
  25.                 RAsc = RAsc + 1
  26.         End If
  27.             RChr = Chr(RAsc)
  28.             LChr = Chr(LAsc)
  29.             .Cells(r + 1, 3) = ThisWeekNm & "DM" & LChr & RChr
  30.     Else
  31.         If response = vbYes And Len(lastStr) = 6 Then
  32.             '無子批欲增加子批
  33.             RAsc = Asc(Right(lastStr, 1))
  34.             LAsc = Asc(Right(lastStr, 2))
  35.             RAsc = RAsc + 1
  36.             RChr = Chr(RAsc)
  37.             LChr = Chr(LAsc)
  38.             response2 = MsgBox("是否根據上一批新增子批(Yes/No) ?", 4, "提示")
  39.             If response2 = vbNo Then
  40.             '不根據上批ID,而新增ID及子批
  41.                 .Cells(r + 1, 3) = ThisWeekNm & "DM" & LChr & RChr & "B001"
  42.                 ElseIf response2 = vbYes Then
  43.             '根據上批ID作新增子批
  44.                 .Cells(r + 1, 3) = lastStr & "B001"
  45.             End If
  46.         ElseIf response = vbYes And Len(lastStr) = 10 Then
  47.             '有子批欲增加子批
  48.             RAsc = Asc(Right(lastStr, 1))
  49.             RAsc = RAsc + 1
  50.             RChr = Chr(RAsc)
  51.             .Cells(r + 1, 3) = Left(lastStr, 9) & RChr
  52.         Else
  53.             '有子批不想增加子批
  54.             LAsc = Asc(Right(lastStr, 6))
  55.             RAsc = Asc(Right(lastStr, 5))
  56.                 If RAsc < 57 And RAsc > 47 Then
  57.                     RAsc = RAsc + 1
  58.                 ElseIf RAsc = 57 Then
  59.                     RAsc = RAsc + 8
  60.                 ElseIf RAsc < 90 And RAsc > 65 Then
  61.                     RAsc = RAsc + 1
  62.                 ElseIf RAsc = 90 Then
  63.                     LAsc = LAsc + 1
  64.                     RAsc = 48
  65.                 Else
  66.                     RAsc = RAsc + 1
  67.                 End If
  68.                 RChr = Chr(RAsc)
  69.                 LChr = Chr(LAsc)
  70.                 .Cells(r + 1, 3) = ThisWeekNm & "DM" & LChr & RChr
  71.             End If
  72.         End If
  73.     End If
  74. End With
  75. End Sub
複製代碼
問題1_2013-05-21.zip (22.75 KB)

TOP

        靜思自在 : 做該做的事是智慧，做不該做的事是愚癡。
返回列表 上一主題