Question

我想在宏中给出初始数字（在这个例子中为T00101）并且我想用A代码满足条件填充A列中的空单元格（在C列中它具有“好”值），这样如果B列中的单元格没有变化，则增加1;如果B列有变化，则增加100（从先前名称的第一次出现开始计算）。

如果在C列中单词为“false”，则A中的单元格将保持为空。这是单词的第一个外观始终以01结尾，单词的第二个外观以02结尾。如果名称发生变化，则数字的前3位数增加1.（T后的3个字符）信）

我希望这样做：

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

编号取决于更改另一列中的单元格值 - vba代码

2 个答案: