全部,我有以下代码,但我需要知道如何修改它。我需要一个提示或消息框询问我,要查找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
此外,这是代码的一个子集,它将搜索要插入的确切行。
答案 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