Excelmacros:根据用户input插入行

在列A填充不同date的Excel文件中,按升序sorting,macros应生成一个用户提示,要求inputdate。 该macros应该在两个date之间插入一个小于和大于用户给出的date的行。

到目前为止,我只实现了提示用户在macros下面插入一个新行的特定行。 任何人都可以帮助我下一步?

Sub addRow() Dim row row = InputBox("Maturity date of new bond", "Input maturity date") If Not row = vbNullString Then ActiveSheet.Range("A" & row + 1).EntireRow.Insert End If End Sub 

对于塔尔辛的回答,我很荣幸,但是我注意到的一些问题 (例如,没有考虑到用户input无效date格式的可能性)。

另外,我想你可能真的想知道代码到底是怎么回事。 所以,我用大量的注释和解释创build了下面的子程序。 我希望它能find你。

祝你好运!


 Sub addRow() ' ============================================================================================================ ' This is sort of the easy part, taken somewhat from the code you provided. We're going to create some ' variables to use later, and give our user an input field for the maturity date. ' NOTE: You said the date was in column A, but in case that isn't always true, I also use a ' range-selector input box to allow the user to specify the range / column containing maturity dates. ' ============================================================================================================ Dim d As Date ' Create our maturity date Dim dateColumn As Range ' Create a variable to store our date column Dim isAscOrder As Boolean ' Create a variable to store a value that will indicate in what direction the dates are sorted Dim i As Long, j As Long, k As Long, c As Range, r As Range ' Create a few misc variables (I always do this just in case I need them later on) On Error GoTo cancel ' We want to assume any errors on the next line are caused by the user pressing the "Cancel" button. Set dateColumn = Application.InputBox("Column containing maturity dates", "Specify maturity date column", Type:=8) ' Show the range-selector input box and store it in our date-column variable retryDate: ' this is called a "Line Label". We can send user here to retry the next action On Error GoTo invalidDate ' If the next line causes an error, we will send user to our "invalidDate" label (see below) d = InputBox("Maturity date of new bond", "Input maturity date") ' Show the input-box and store the date value specified by the user On Error GoTo 0 ' Set the error-handling back to its default ' ============================================================================================================ ' Here comes the slightly more advanced part. The general idea here is that we want to find the spot in which ' this date should fit, but we don't even know in what direction the dates are currently sorted. ' --------------------------------------------------------------------------------------------------------- ' (1) So, first we'll determine the sort direction by comparing the first cell to the last cell. ' Also note that I am specifying "Column(1)" in case the user entered a range with multiple ' columns by mistake. ' (2) Next, I'll loop through each cell in the range using the "For each" statement. Within each ' of these iterations, I will check if the cell's date is greater/less than (this will ' depend on the sort direction) the maturity date specified by the user. ' (3) Finally, when I find a cell that is greater/less than our maturity date, I will insert a ' new row before that row. ' --------------------------------------------------------------------------------------------------------- ' Sound good? Okay, here we go . . . ' ============================================================================================================ isAscOrder = (CDate(dateColumn.Cells(1, 1).Value) < CDate(dateColumn.Columns(1).End(xlDown).Value)) ' compare the first and last cells of the first column to determine the sort direction For Each c In dateColumn.Columns(1).Cells ' begin the "For Each" loop; this will loop through each cell in the first column of our range If c.Row() > dateColumn.Parent.UsedRange.Rows.Count() Then Exit Sub ' Proceed only if we have not reached end of the "Used Range" (ie, the end of our worksheet) If isAscOrder Then ' If this is in ascending order, then ... If CDate(c.Value) > d Then ' ... we will check for the first cell greater than our maturity date. c.EntireRow.Insert shift:=xlShiftDown ' When/if we find it, then insert the new row above the current one, and then ... Exit Sub ' ... exit the sub (because we are done). End If Else ' If this is not in ascending order, then we will assume descending order (duh), and then ... If CDate(c.Value) < d Then ' ... we will check for the first cell less than our maturity date. c.EntireRow.Insert shift:=xlShiftDown ' When/if we find it, then insert the new row above the current one, and then ... Exit Sub ' ... exit the sub (because we are done). End If End If Next c ' No greater/less than date was found; proceed to the next iteration of our "For Each" loop (ie, the next cell). ' ============================================================================================================ ' Our code execution shouldn't come down this far (since we handle all possible scenarios above, and each one ' results in exiting the sub. However, we do need to specify some code to handle our errors. ' ============================================================================================================ Exit Sub ' We shouldn't ever get to this point, but exit the sub just in case. invalidDate: If MsgBox("Please enter a valid date (ie,""mm/dd/yyyy"")", vbRetryCancel, "Invalid Date") = vbCancel Then ' Display the "invalid date" error, and ask the user if he or she would like to retry. If "Cancel" is clicked, then ... Exit Sub ' ... exit the sub. Else ' If the user clicked "Retry", then ... GoTo retryDate ' ... send them back to the date input box (ie, the "retryDate" label). End If cancel: Exit Sub End Sub 

正如我在评论中所说,我只是迭代你的date列,直到你find一个更大的date(我说在评论中较小,但如果是升序,较大的date将接近底部)。

 Sub addRow() Dim givenDate As Date givenDate = InputBox("Maturity date of new bond", "Input maturity date") If givenDate <> vbNullString Then Dim iter As Range Set iter = ActiveSheet.Range("A1") Do Set iter = iter.Offset(1) Loop While iter.Value <= givenDate iter.EntireRow.Insert xlDown Set iter = iter.Offset(-1) iter.Value = givenDate End If End Sub 

你可能需要做更多的错误检查,但这应该做的伎俩。