返回列表 上一主題 發帖

編列序號問題

sheau-lan

帖子
96 
主題
24 
精華
0 
積分
149 
點名
0  
作業系統
WINDOWES 
軟體版本
OFFICE 
閱讀權限
20 
性別
女 
註冊時間
2011-10-11 
最後登錄
2018-9-25 
1# 跳轉到 » 正序看帖
打印
tT
發表於 2015-6-11 08:44 | 只看該作者

編列序號問題

如何讓編號自動產生
詢求各位大大幫忙

序號問題.rar (22.24 KB)

收藏 分享

sheau-lan

帖子
96 
主題
24 
精華
0 
積分
149 
點名
0  
作業系統
WINDOWES 
軟體版本
OFFICE 
閱讀權限
20 
性別
女 
註冊時間
2011-10-11 
最後登錄
2018-9-25 
4#
發表於 2015-7-1 07:45 | 只看該作者
luhpro大,上次是你幫我解的,這次編碼有一些不一樣,但大同小異
可否請再幫忙

自動編碼.rar (11.2 KB)

TOP

sheau-lan

帖子
96 
主題
24 
精華
0 
積分
149 
點名
0  
作業系統
WINDOWES 
軟體版本
OFFICE 
閱讀權限
20 
性別
女 
註冊時間
2011-10-11 
最後登錄
2018-9-25 
3#
發表於 2015-6-15 10:54 | 只看該作者
luhpro 大大..就是這樣....謝謝你歐..感激不盡...

TOP

luhpro

帖子
835 
主題
6 
精華
0 
積分
915 
點名
16  
作業系統
Win 10,7 
軟體版本
2019,2013,2003 
閱讀權限
50 
性別
男 
註冊時間
2010-5-3 
最後登錄
2024-11-14 
2#
發表於 2015-6-13 08:29 | 只看該作者
如何讓編號自動產生
詢求各位大大幫忙
sheau-lan 發表於 2015-6-11 08:44

你的範例檔有些地方邏輯性不一致,
這裡只能先依我理解的規則來試做.

1.每個 Range 間固定只留 4 的倍數的空白列,
超過且未達 4 的倍數的空白列無條件刪除,
每多 4 個空白列 規格的序號加 1

2.只考慮變更 品號 所在列自動編號 規格-英文字,
對於其下資料並未做重新編號的處理.
  1. Private Sub Worksheet_Change(ByVal Target As Range)
  2. On Error GoTo 99
  3. Dim TG As Range
  4. With Target
  5. If .Row >= 3 And .Column = 1 Then
  6.      If .Value = "" Then
  7. 98:      .Offset(0, 2) = ""
  8.          .Offset(0, 3) = ""
  9.          .Offset(0, 5) = ""
  10.          .Offset(0, 6) = ""
  11.   
  12.   Else: Set TG = Sheet7.[H3:H9999].Find("*" & .Value & "*", , , xlWhole)
  13.              If TG Is Nothing Then GoTo 98
  14.                 .Offset(0, 2) = TG.Offset(0, -6).Value
  15.                TG2 = .Offset(0, 2).Value
  16.                 .Offset(0, 3) = TG.Offset(0, -3).Value
  17.                 .Offset(0, 9) = TG.Offset(0, -2).Value
  18.                 .Offset(0, 5) = Application.VLookup(TG2, Sheet15.[A4:H9999], 8, False)
  19.                      If IsError(.Offset(0, 5).Value) Then .Offset(0, 5) = ""
  20.                 .Offset(0, 6) = TG.Offset(0, 1).Value
  21.                 Dim N%, N1%, S1$, C%, S2$
  22.                 N = 0
  23.                 Set TG = .Offset(-1, 7)
  24.                 While TG = ""
  25.                   Set TG = TG.Offset(-1)
  26.                   N = N + 1
  27.                 Wend
  28.                
  29.                 N1 = Mid(TG, 2, Len(TG) - 3)
  30.                 S1 = Right(TG, 1)
  31.                
  32.                 C = 0
  33.                 S2 = TG
  34.                 While TG = S2
  35.                   Set TG = TG.Offset(-1)
  36.                   C = C + 1
  37.                 Wend
  38.                
  39.                 If N > 3 Then
  40.                   N1 = N1 + Int((N - 3) / 4) + 1
  41.                   S1 = "A"
  42.                   With Range(.Offset(0), .Offset(, 9)).Borders(xlEdgeTop)
  43.                     .LineStyle = xlContinuous
  44.                     .ColorIndex = 37
  45.                     .Weight = xlHairline
  46.                   End With
  47.                   N = N - (Int(N / 4) * 4)
  48.                 Else
  49.                   If C > 3 Then S1 = Chr(Asc(S1) + 1)
  50.                 End If
  51. Application.EnableEvents = False
  52.                 .Offset(, 7) = "M" & N1 & "-" & S1
  53.                 If N > 0 And N < 4 Then
  54.                   Range(Rows(.Row - 1), Rows(.Row - N)).Delete
  55.                   .Offset(1).Select
  56.                 End If
  57. Application.EnableEvents = True
  58.              End If
  59.   End If
  60. End With
  61. 99
  62. End Sub
複製代碼

TOP

        靜思自在 : 為自己找藉口的人永遠不會進步。
返回列表 上一主題