Question

我想屏幕显示以“D”开头的值的所有工作表在板材中，我形成了块（1列，4行） - 老板 - 区域 - 包裹（总是以“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会抛出错误;
尽量避免使用Select，ActiveCell等;（How to avoid using Select in Excel VBA）;
用英文写评论，而不是荷兰语（对于变量名也是好主意，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

如何在每个细胞上方找到细胞的价值

2 个答案: