編號取決於更改另一列中的單元格值 - vba代碼

Question

我想給宏中的初始數字（在此示例中爲T00101），並且如果滿足條件（在列C具有「良好」的值），所以如果列B中的單元格沒有變化，則將其增加1，如果列中有變化，則將增加100（從先前名稱的第一次出現開始計數） B.

如果在列C中該單詞爲「假」，則A中的單元格將保持空。 這是該詞的第一次出現總是以01結尾，該詞的第二次出現以02結尾。如果名稱中有變化，則該數字的前三位數字增加1。牛逼信）

我想這是一個結果：

A  B  C 
Id  Name Status 
T00101 Apple good 
T00102 Apple good 
T00103 Apple good 
T00201 Peach good 
T00301 Orange good 
     Banana false 
T00401 Grapes good 
T00402 Grapes good 

我有這個，但它不能正常工作......爲宏任何其他建議？

Sub numbering() 
    Sheet1.Select 
    Dim Start As Long 
    Dim Piece As String 
    Dim lastrow As Long 
    Dim erow As Long 
    lastrow = Sheet1.Cells(Rows.Count, 2).End(xlUp).Row 
    erow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row 
    Start = 00101 
    Piece = 0 
    For i = erow To lastrow 
     If Cells(i, 3) = "good" Then 
      Sheet1.Cells(i, 1) = Start 
      If Cells(i, 2) = Cells(i + 1, 2) Then 
       Piece = Piece + 1 
       Start = Start + 1 
      Else: 
       Sheet1.Cells(i, 1) = Start - Piece + 100 
      End If 
     End If 
    Next i 
End Sub 

Answer 1

這給一試：

Sub FillA() 
    Dim SeqNum As Long, iNum As Long 
    Dim N As Long, i As Long 

    SeqNum = 100 
    iNum = 1 
    Range("A2").Value = "T" & Format(SeqNum + iNum, "00000") 
    N = Cells(Rows.Count, "B").End(xlUp).Row 

    For i = 3 To N 
     If Cells(i, "C").Value = "good" And Cells(i, "B").Value = Cells(i - 1, "B").Value Then 
      iNum = iNum + 1 
      Cells(i, "A").Value = "T" & Format(SeqNum + iNum, "00000") 
     End If 

     If Cells(i, "C").Value = "good" And Cells(i, "B").Value <> Cells(i - 1, "B").Value Then 
      iNum = 1 
      SeqNum = SeqNum + 100 
      Cells(i, "A").Value = "T" & Format(SeqNum + iNum, "00000") 
     End If 

     If Cells(i, "C").Value <> "good" Then 
      Cells(i, "A") = "" 
     End If 
    Next i 

End Sub 

Answer 2

這應該做的伎倆，我已經添加了一些註釋來解釋：

Sub numbering() 
Sheet1.Select 
' You need to treat the Id as a String, 
' but also create Integers to keep track of the numbering components 
Dim theId As String 
Dim idLetter As String 
Dim txt_idCategory As String 
Dim txt_idNumber As String 
Dim idCategory As Integer 
Dim idNumber As Integer 
Dim firstRow As Integer 
Dim lastRow As Integer 

    firstRow = 2 ' sets the first row to start updating the Id 
    lastRow = Sheet1.Cells(Rows.Count, 2).End(xlUp).Row ' finds the last row 
    idLetter = "T" ' set your letter 
    idNumber = 1 ' first Id number will always be 1 

For i = firstRow To lastRow ' loop through the rows 
    If Cells(i, 3).Value <> "good" Then ' skip the row if Status not equal "good" 
     GoTo nextOne 
    End If 

    If Cells(i, 2).Value <> Cells(i - 1, 2).Value Then ' if the name changes (or it's the first one) 
     idCategory = idCategory + 1 ' increment the category 
     idNumber = 1 ' and increment the number 
    Else ' otherwise 
     idNumber = idNumber + 1 ' just increment the number 
    End If 

    Select Case Len(CStr(idCategory)) ' based on the length of the category, append "0's" to the front 
     Case 1 
      txt_idCategory = "00" & CStr(idCategory) 
     Case 2 
      txt_idCategory = "0" & CStr(idCategory) 
     Case 3 
      txt_idCategory = CStr(idCategory) 
     Case Else 
      MsgBox "Category over 3 digits not catered for, macro will end" 
      Exit Sub 
    End Select 

    Select Case Len(CStr(idNumber)) ' based on the length of the number, append "0's" to the front 
     Case 1 
      txt_idNumber = "0" & CStr(idNumber) 
     Case 2 
      txt_idNumber = CStr(idNumber) 
      MsgBox "Id Number over 2 digits not catered for, macro will end" 
      Exit Sub 
    End Select 

    theId = idLetter & txt_idCategory & txt_idNumber ' put all 3 parts together 
    Cells(i, 1).Value = theId ' update the cell with the id 

nextOne: 
Next i 

End Sub