Board logo

標題: 請教版主及各位高手:如何在多個群組裡新增序號並自動進位? [打印本頁]
作者: cmo140497    時間: 2013-5-21 09:47     標題: 請教版主及各位高手:如何在多個群組裡新增序號並自動進位?

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

[attach]15042[/attach]

[attach]15043[/attach]
作者: GBKEE    時間: 2013-5-21 13:44

回復 1# cmo140497
你可以上傳對照於,新增序號,並自動進位,的範例.
作者: cmo140497    時間: 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
複製代碼
[attach]15047[/attach]



歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)