根据可变文本字符串搜索col C插入X行数

时间:2017-09-15 17:40:42

标签: excel-vba vba excel

我的电子表格中包含cols a-z中的数据。此脚本适用于Col数据,但我希望它搜索col C.如何在col c中搜索字符串?我没有找到任何字符串或没有插入行。

Option Explicit     
Sub Insert_Rows()     
Dim i As Long, lRows As Long, lastrow As Long, lngCount As Long
Dim strTxt As String     
Application.ScreenUpdating = False     
lastrow = Cells(Rows.Count, "A").End(xlUp).Row

lRows = Application.InputBox("How many rows do you want to insert?", Type:=1)

If lRows < 1 Then
    MsgBox " You must enter a number greater than zero"
    Exit Sub
End If

strTxt = Application.InputBox("Enter the text string to search on. Rows will be inserted below each cell containing this string.")

If Len(strTxt) < 1 Then
    MsgBox "You must enter a text string consisting of at least one character"
    Exit Sub
End If

With ActiveSheet

    lngCount = Application.WorksheetFunction.CountIf(.Range("A1:A" & lastrow), strTxt)

    If lngCount < 1 Then
        MsgBox "The text string you entered is not listed - cancelling", vbExclamation
        Exit Sub
    End If

    On Error Resume Next

    For i = lastrow To 1 Step -1
        If .Cells(i, 1).Value = strTxt Then
            .Range("A" & i + 1 & ":A" & i + lRows).Insert shift:=xlDown
        End If
    Next i

End With     
Application.ScreenUpdating = True          
End Sub

1 个答案:

答案 0 :(得分:0)

您的直接问题已在问题的评论中得到解答。我倾向于将这些更改更进一步,并用变量替换硬编码列“A”或“C”。然后该函数可用于任何列。

例如,这是您的代码,经过修改以从另一个用户提示符获取该列:

Sub Insert_Rows()
Dim i As Long, lRows As Long, lastrow As Long, lngCount As Long
Dim col As String, strTxt As String

Application.ScreenUpdating = False

col = Application.InputBox("Which column should be inserted into?", Type:=2)
lastrow = Cells(Rows.Count, col).End(xlUp).Row

lRows = Application.InputBox("How many rows do you want to insert?", Type:=1)
If lRows < 1 Then
    MsgBox " You must enter a number greater than zero"
    Exit Sub
End If

strTxt = Application.InputBox("Enter the text string to search on. Rows will be inserted below each cell containing this string.")
If Len(strTxt) < 1 Then
    MsgBox "You must enter a text string consisting of at least one character"
    Exit Sub
End If

With ActiveSheet
    lngCount = Application.WorksheetFunction.CountIf(.Range(col & "1:" & col & lastrow), strTxt)

    If lngCount < 1 Then
        MsgBox "The text string you entered is not listed - cancelling", vbExclamation
        Exit Sub
    End If

    On Error Resume Next

    For i = lastrow To 1 Step -1
        If .Cells(i, col).Value = strTxt Then
            .Range(col & i + 1 & ":" & col & i + lRows).Insert shift:=xlDown
        End If
    Next i
End With

Application.ScreenUpdating = True
End Sub