查找给定范围内的所有非零单元格,并在另一个工作表中列出其地址

时间:2018-03-29 09:49:28

标签: excel vba excel-vba

我在excel(720x720)中有一个巨大的表,我想在其中找到非零值。当找到该值时,我想将这一行的前两个单元格放在两列上的新工作表上,第三个单元格中的单元格以及单元格列中的前两个单元格我要查找另外两列。

例如,如果我的值在表格1中的E26 R89和Z9中,我想在表格2上找到一个如下所示的表格:

      A      B      C     D     E
1    A26    B26    E26    E1    E2   
2    A89    B89    R89    R1    R2
3    A9     B9     Z9     Z1    Z2

以下是我迄今为止所尝试的内容(请记住,您正在与初学者交谈)

Sub tests_selection()
    Dim r As Worksheet
    Dim c As Workbook, f As Worksheet
    Set c = Workbooks("classeur1")
    Set f = c.Worksheets("feuil1")

    Dim a(5200)
    Dim b

    b = 0

    Range("A1:AAU723").Select
    For i = 4 To 720
        For j = 4 To 723
            If f.Cells(i, j).Value <> 0 Then
            a(b) = f.Cells(i, j).Adress
            b = b + 1
            End If

        Next j
    Next i

    Set r = c.Worksheets("result")

    For i = 0 To b
        r.Cells(i, 1).Value = a(i)
    Next i    
End Sub

表示例
Table example

结果示例
Result example

1 个答案:

答案 0 :(得分:0)

首先,您应该使用有意义的变量名而不是仅1个字符。这使您的代码更易于理解和读取,因此可以减少错误。

还使用Option Explicit强制进行适当的变量声明。

Option Explicit

Sub tests_selection()
    Dim SrcWs As Worksheet
    Set SrcWs = Worksheets("feuil1") 'source worksheet

    Dim ResultWs As Worksheet
    Set ResultWs = Worksheets("result") 'result worksheet

    Dim rRow As Long
    rRow = 2 'start row in result sheet

    Dim iCell As Range
    For Each iCell In SrcWs.Range("C4:AN40") '<-- make sure to adjust the range to the data only! so header rows are not included
        If iCell.Value <> 0 Then
            ResultWs.Cells(rRow, 1).Value = SrcWs.Cells(iCell.Row, 1).Value
            ResultWs.Cells(rRow, 2).Value = SrcWs.Cells(iCell.Row, 2).Value
            ResultWs.Cells(rRow, 3).Value = iCell.Value
            ResultWs.Cells(rRow, 4).Value = SrcWs.Cells(1, iCell.Column).Value
            ResultWs.Cells(rRow, 5).Value = SrcWs.Cells(2, iCell.Column).Value

            rRow = rRow + 1
        End If
    Next iCell
End Sub