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

cmo140497

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

下載 (114.23 KB)

2013-5-21 09:43

新增 Microsoft Excel 工作表.zip (18.74 KB)

下載次數: 4

2013-5-21 09:44

cmo140497

回復 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)

下載次數: 4

2013-5-21 14:13

GBKEE

回復 1# cmo140497
你可以上傳對照於,新增序號,並自動進位,的範例.