Excel VBA编码

时间:2016-10-27 08:30:42

标签: excel-vba vba excel

我是VBA编码的新手,你能帮助我解决这个问题吗?

我目前正在创建一个宏,它将搜索AJ列中的特定文本(例如" Chase"),如果找到,它将从A列中查找实体,然后将其粘贴到其他表。

enter image description here

enter image description here

非常感谢提前!

2 个答案:

答案 0 :(得分:0)

试试这个。取自评论。请记住,您可能会得到的错误是因为VLookup公式。你需要看看VLookup公式是如何工作的 =VLOOKUP(Value you want to look up, range where you want to lookup the value, the column number in the range containing the return value, Exact Match or Approximate Match – indicated as 0/FALSE or 1/TRUE).

该公式正在搜索“检查”。您获得的错误在您搜索的范围内,您正在搜索“AE7:A2693”,即AE到A列 - 无法向后搜索,因此它应该是A2693:AE7。您必须找到正确的范围并在下面的代码中进行更改 您确定第31列包含返回值吗?

Sub EachLoopExample()

Dim ws1 As Worksheet, ws2 As Worksheet
Dim MyCell As Range
Dim sResult As String

Set ws1 = Sheets("Sheet1")
Set ws2 = Sheets("Sheet3")
For Each MyCell In ws1.Range("AE:AE")
    If MyCell.Value = "check" Then

        sResult = Application.WorksheetFunction.VLookup("check", ws1.Range("B1:C3"), 1, False)
        ws2.Range("A2").Value = sResult
    End If
Next MyCell
End Sub

答案 1 :(得分:0)

Sub EachLoop()

Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim FinalRow As Integer
Dim i As Integer

Set ws1 = Sheet1
Set ws2 = Sheet3

ws1.Select
FinalRow = Cells(Rows.Count, 1).End(xlUp).Row

For i = 7 To FinalRow
    If Cells(i, 31) = "check" Then
        Range(Cells(i, 1), Cells(i, 7)).Copy
        ws2.Select
        Range("A200").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValuesAndNumberFormats
        ws1.Select
    End If

Next i

ws2.Select

Range("B2").Select

Call EachLoop2

End Sub

Sub EachLoop2()

Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim FinalRow As Integer
Dim i As Integer

Set ws1 = Sheet1
Set ws2 = Sheet3

ws1.Select
FinalRow = Cells(Rows.Count, 1).End(xlUp).Row

For i = 7 To FinalRow
    If Cells(i, 32) = "check" Then
        Range(Cells(i, 1), Cells(i, 13)).Copy
        ws2.Select
        Range("H200").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValuesAndNumberFormats
        ws1.Select
    End If

Next i

ws2.Select

Range("B2").Select

Call EachLoop2_ext


End Sub

Sub EachLoop2_ext()

Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim FinalRow As Integer
Dim i As Integer

Set ws1 = Sheet1
Set ws2 = Sheet3

ws2.Select
FinalRow = Cells(Rows.Count, 1).End(xlUp).Row

For i = 3 To FinalRow
    If Range(Cells(i, 9), Cells(i, 13)) = "" Then
        ws2.Select
        Range(Cells(i, 9), Cells(i, 13)).ClearContents
        Range(Cells(i, 14), Cells(i, 20)).Cut
        Range("I200").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValuesAndNumberFormats

    Else
        ws2.Select
        Range(Cells(i, 9), Cells(i, 13)).ClearContents
        Range(Cells(i, 14), Cells(i, 20)).Cut
        Range("I200").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValuesAndNumberFormats

    End If

Next i

ws2.Select

Range("I2").Select

End Sub