根据提示的单元格值插入整行

时间:2017-04-27 20:46:49

标签: excel vba excel-vba

全部,我有以下代码,但我需要知道如何修改它。我需要一个提示或消息框询问我,要查找A列中的哪个值。它应该在Sheet1列A中找到相应的值,并将数据从A列复制到AL到sheet2。

这是我的代码:

Sub MM1()
  Dim Check As Range, r As Long, lastrow2 As Long, lastrow As Long
  Application.ScreenUpdating = False
  lastrow = Worksheets("Sheet1").UsedRange.Rows.Count
  lastrow2 = Worksheets("Sheet2").UsedRange.Rows.Count
  If lastrow2 = 1 Then lastrow2 = 0
    For r = lastrow To 2 Step -1
      If Range("E" & r).Value = "Yes" Then
        Rows(r).Cut Destination:=Worksheets("Sheet2").Range("A" & lastrow2 + 1)
        lastrow2 = lastrow2 + 1
    Else:
  End If
  Next r
  Application.ScreenUpdating = True
End Sub

此外,这是代码的一个子集,它将搜索要插入的确切行。

1 个答案:

答案 0 :(得分:1)

您不需要在sheet1中的行中手动循环,只需使用VBA的本机Find函数。此外,您目前无法获得用户输入,这可以通过InputBox来实现。

有关代码的详细信息,请参阅注释。

此示例复制第一场比赛的数据

$(document).on("click", $('.sortable'), function (e) {
    $('.sortable').sortable({
        start: function (event, ui) {
            var start_pos = ui.item.index();
            ui.item.data('start_pos', start_pos);
        },
        change: function (event, ui) {
            var start_pos = ui.item.data('start_pos');
            var index = ui.placeholder.index();
            if (start_pos < index) {
                $('.sortable :nth-child(' + index + ')').addClass('highlights');
            } else {
                $('.sortable').children(' :eq(' + (index + 1) + ')').addClass('highlights');
            }
        },
        update: function (event, ui) {
            var redirectUrl = $('#hiddenRedirectUpdateOrder').val();
            $.ajax({
                url: redirectUrl,
                type: 'POST',
                cache: false,
                contentType: 'application/json',
                data: JSON.stringify({ orders: $(this).sortable('toArray') }),
            });
            $('.sortable').removeClass('highlights');
        }
    });
});

此示例复制列中每个匹配项的数据:

Sub MM1()
    Dim lastrowsheet2 As Long
    ' Use last cell in UsedRange for its row number, 
    ' if row 1,2,... aren't used, then UsedRange will be shorter than you expect!
    With ThisWorkbook.Sheets("Sheet2").UsedRange
        lastrowsheet2 = .Cells(.Cells.Count).Row
    End With
    ' Get user input for a search term
    Dim userinput As String
    userinput = InputBox("Enter a value to search for.", "Column A Search")
    ' Search for value
    Dim findrange As Range
    Set findrange = ThisWorkbook.Sheets("Sheet1").Columns("A").Find(what:=userinput, lookat:=xlWhole, LookIn:=xlValues)
    If findrange Is Nothing Then
        MsgBox "No matching search results"
    Else
        lastrowsheet2 = lastrowsheet2 + 1
        ' Copy values in found row to sheet 2, in new last row
        ThisWorkbook.Sheets("Sheet2").Range("A" & lastrowsheet2, "AL" & lastrowsheet2).Value _
            = ThisWorkbook.Sheets("Sheet1").Range("A" & findrange.Row, "AL" & findrange.Row).Value
    End If
End Sub