Question

我想我错过了一些东西，如何将输出写入新表？

Set rng1 = Worksheets("blad1").Range("B8", Worksheets("blad1").Range("B" & Rows.Count).End(xlUp))
Set rng2 = Worksheets("blad2").Range("B1", Worksheets("blad2").Range("B" & Rows.Count).End(xlUp))
For Each c In rng1
    If Application.WorksheetFunction.CountIf(rng1, c) > 0 Then

        RowNo = Application.WorksheetFunction.Match(c, rng2)
        c.Offset(45, 0).Resize(1, 2).Value = Worksheets("blad2").Range("B" & RowNo, "C" & RowNo).Value 

    End If Next c

Answer 1

未测试：

Dim b1 As Worksheet, b2 As Worksheet, b3 As Worksheet, m

Set b1 = Worksheets("blad1")
Set b2 = Worksheets("blad2")
Set b3 = Worksheets("blad3")

Set rng1 = b1.Range(b1.Range("B8"), b1.Range("B" & Rows.Count).End(xlUp))
Set rng2 = b2.Range(b2.Range("B1"), b2.Range("B" & Rows.Count).End(xlUp))
Set rng3 = b3.Range("A1")

For Each c In rng1

    m = Application.Match(c.Value, rng2) 'no "WorksheetFunction"
    'm will be an error value if no match found
    If Not IsError(m) Then 
        rng3.resize(1,2).Value = b2.Cells(RowNo, "B").Resize(1,2).Value
        Set rng3 = rng3.Offset(1, 0) 
    End If

Next c

Vba偏移到新表

1 个答案: