番号は、別の列のセル値を変更することに依存します。 - VBAコード

Question

マクロ内の最初の番号（この例ではT00101）を与え、条件を満たす場合は列Aの空のセルにコードを入力します列Cには「良い」値がある）、列Bのセルに変更がなければ1増加し、列に変化があった場合は100増加する（以前の名前の最初の数から数えられる） B.

C列の単語が「偽」の場合、Aのセルは空のままです。 これは、単語の最初の出現が常に01で終わり、単語の2番目の出現が02で終わります。名前に変更がある場合、数字の最初の3桁が1増加します。 T文字）

私は、結果としてこれをしたいと思います：

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