点击文件名下载附件
请教:多区域数据提取的问题
Sub 提取数据() On Error Resume Next With Sheets("数据") For R = 2 To [A65536].End(xlUp).Row Step 3 X = Application.WorksheetFunction.Match(Cells(R, 1), .Range("a:a"), 0) If X Then Cells(R, 2).Resize(1, 3) = .Cells(X, 5).Resize(1, 3).Value Cells(R + 1, 2).Resize(1, 3) = .Cells(X + 19, 5).Resize(1, 3).Value Cells(R + 2, 2).Resize(1, 3) = .Cells(X + 38, 5).Resize(1, 3).Value X = 0 End If Next R End With End Sub
点击文件名下载附件
请教:多区域数据提取的问题
Sub 提取数据() On Error Resume Next With Sheets("数据") For R = 2 To [A65536].End(xlUp).Row Step 3 X = Application.WorksheetFunction.Match(Cells(R, 1), .Range("a:a"), 0) If X Then Cells(R, 2).Resize(1, 3) = .Cells(X, 5).Resize(1, 3).Value Cells(R + 1, 2).Resize(1, 3) = .Cells(X + 19, 5).Resize(1, 3).Value Cells(R + 2, 2).Resize(1, 3) = .Cells(X + 38, 5).Resize(1, 3).Value X = 0 End If Next R End With End Sub