[英]How to find value of cell above each cell
我想为所有工作表筛选以“ D”开头的值。在工作表中,我使用-所有者-面积-地块(始终以“ D”开头)-交易年份( 1列4行的块)。
我想在“测试”表中进行总结。
我可以找到包裹,但是如何从上方的单元格中获取信息?
Sub Zoek_kavels()
Dim ws As Worksheet
Dim rng As Range
Dim Area
Dim Kavel As String
rij = 1
For Each ws In ActiveWorkbook.Sheets
Set rng = ws.UsedRange
For Each cell In rng
If Left(cell.Value, 1) = "D" Then 'Starts with D
Sheets("Test").Cells(rij, 1) = cell.Value 'Kavel D..
Cells(cell.row - 1, cell.Column).Select
Area = ActiveCell.Value
Sheets("Test").Cells(rij, 2) = Area 'Oppervlakte
Sheets("Test").Cells(rij, 3) = ws.Name 'Werkblad naam
rij = rij + 1
End If
Next
Next
End Sub
有两个要点(还有两个不是很重要)来照顾您的代码:
.row - 1
。 因此,如果您从第1 row-1
开始,则第1 row-1
会引发错误; Select
, ActiveCell
等;( 如何避免在Excel VBA中使用Select ); rij
或kavel
也无济于事); dim Area as String
或as Long
或其他形式; Option Explicit
Sub ZoekKavels()
Dim ws As Worksheet
Dim rng As Range
Dim Kavel As String
Dim rij As Long
Dim cell As Range
rij = 2 'start from the second row to avoid errors in .Row-1
For Each ws In ActiveWorkbook.Worksheets
Set rng = ws.UsedRange
For Each cell In rng
If Left(cell, 1) = "D" Then
With Worksheets("Test")
.Cells(rij, 1) = cell
.Cells(rij, 2) = ws.Cells(cell.Row - 1, cell.Column)
.Cells(rij, 3) = ws.Name
End With
rij = rij + 1
End If
Next
Next
End Sub
或者,您可以使用.Cells(rij, 2) = cell.Offset(-1, 0)
代替Cells(cell.Row - 1, cell.Column)
,如@Shai Rado的注释中所建议。
一个不错的简单循环应该可以解决问题,您可能在工作表中有空格,这会超出使用范围。 这是另一种方法。
Sub Get_CellAboveD()
Dim LstRw As Long, sh As Worksheet, rng As Range, c As Range, ws As Worksheet, r As Long
Set ws = Sheets("Test")
For Each sh In Sheets
If sh.Name <> ws.Name Then
With sh
LstRw = .Cells(.Rows.Count, "A").End(xlUp).Row
Set rng = .Range("A1:A" & LstRw)
If LstRw > 1 Then
For Each c In rng.Cells
If Left(c, 1) = "D" Then
r = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row + 1
ws.Range("A" & r).Value = c
ws.Range("B" & r).Value = c.Offset(-1).Value
ws.Range("C" & r).Value = sh.Name
End If
Next c
End If
End With
End If
Next sh
End Sub
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.