|
楼主 |
发表于 2018-8-11 16:50
|
显示全部楼层
本帖最后由 BMW5566 于 2018-8-11 16:51 编辑
- Private Sub Worksheet_Change(ByVal Target As Range)
- Dim theInputRow&, theDate As Date, theYear&, theMonth&, theDay&
- Dim theColumn&, theNum&, theValue As Variant
- '
- With Target
- theInputRow = .Row
- If theInputRow < 2 Then End
- theColumn = .Column
- End With
- '
- Application.EnableEvents = False
- If theColumn = 9 Or theColumn = 12 Then
- With Me
- .Range(.Cells(theInputRow, 13), .Cells(theInputRow, 20)).ClearContents
- theValue = .Cells(theInputRow, 9)
- If IsNumeric(theValue) Then
- theNum = CLng(theValue)
- If theNum > 0 Then
- theValue = .Cells(theInputRow, 12)
- If IsDate(theValue) Then
- theDate = CDate(theValue)
- theYear = Year(theDate)
- theMonth = Month(theDate)
- theDay = Day(theDate)
- Call theStrInput(theInputRow, theNum, theYear, theMonth, theDay)
- End If
- End If
- End If
- End With
- End If
- Application.EnableEvents = True
- End Sub
- Private Sub theStrInput(theInputRow&, theNum&, theYear&, theMonth&, theDay&)
- Dim thePreviousRow&, theStr$, thePreviousNum&, theColumn&
- Dim i&, a As Variant, theStrFirst$, theStrLast$
- '
- thePreviousRow = theInputRow - 2
- With Me
- Do While thePreviousRow > 1
- For theColumn = 20 To 13 Step -1
- theStr = .Cells(thePreviousRow, theColumn)
- If theStr <> "" Then
- theStr = Right(theStr, 4)
- If IsNumeric(theStr) Then thePreviousNum = CLng(theStr)
- Exit Do
- End If
- Next theColumn
- thePreviousRow = thePreviousRow - 2
- Loop
- theStrFirst = "SQB" & Right(theYear, 2) & Format(theMonth, "00") & Format(theDay, "00")
- ReDim a(1 To theNum)
- For i = 1 To theNum
- theStrLast = theStrFirst & Format(i + thePreviousNum, "0000")
- a(i) = theStrLast
- Next i
- .Cells(theInputRow, 13).Resize(, theNum) = a
- End With
- End Sub
复制代码
|
|