如何在每個單元格上方查找單元格的值

Question

我想為所有工作表篩選以“ 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

Answer 1

有兩個要點（還有兩個不是很重要）來照顧您的代碼：

• 從第2行開始，因為您正在使用.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的注釋中所建議。

Answer 2

一個不錯的簡單循環應該可以解決問題，您可能在工作表中有空格，這會超出使用范圍。 這是另一種方法。

   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