[已解决]求未出现数据

left369

求未出现数据。

最佳答案

月排行榜 / 总排行榜

xdragon

2014-9-30 13:59

Sub test()
    Dim arr, brr$(999), ar, i%, re$(999, 0), cnt%, lastcol%, rng As Range
    For i = 0 To 999
       brr(i) = i
    Next
    arr = Sheets("sheet1").Range("DE1").CurrentRegion.Value
    For Each ar In arr
       brr(ar) = ""
    Next
    For i = 0 To 999
       If brr(i) <> "" Then re(cnt, 0) = Format(brr(i), "'000"): cnt = cnt + 1
    Next
    Set rng = Sheets("sheet2").Cells.SpecialCells(xlCellTypeLastCell)
    If rng.Column = 1 And Len(rng) = 0 Then lastcol = 1 Else lastcol = rng.Column + 1
    Sheets("sheet2").Cells(1, lastcol).Resize(cnt, 1) = re
End Sub

跳转到最佳答案楼层

baksy

是一列中没出现还是区域内没出现？

left369

baksy 发表于 2014-9-30 09:52
是一列中没出现还是区域内没出现？

给出数据的整个区域块。数据区域可能有增减列。

xdragon

Sub test()
    Dim arr, brr$(999), ar, i%, re$(999, 0), cnt%
    For i = 0 To 999
       brr(i) = i
    Next
    arr = Sheets("sheet1").Range("DE1").CurrentRegion.Value
    For Each ar In arr
       brr(ar) = ""
    Next
    For i = 0 To 999
       If brr(i) <> "" Then re(cnt, 0) = Format(brr(i), "'000"): cnt = cnt + 1
    Next
    Sheets("sheet2").Cells(1, EmptyColumn("Sheet2", 1)).Resize(cnt, 1) = re
End Sub

Function EmptyColumn(Sheetname$, i%)
    If Sheets(Sheetname).Cells(Rows.Count, i).End(xlUp).Row = 1 And Len(Sheets(Sheetname).Cells(1, i)) = 0 Then
        EmptyColumn = i
        Exit Function
    Else
        EmptyColumn = EmptyColumn(Sheetname, i + 1)
    End If
End Function

left369

xdragon 发表于 2014-9-30 10:05
Sub test()
    Dim arr, brr$(999), ar, i%, re$(999, 0), cnt%
    For i = 0 To 999

后面那段有点复杂哦。

xdragon

left369 发表于 2014-9-30 13:06
后面那段有点复杂哦。

你想要简单点也可以，就是定位最后一个单元格所在列+1，如果是A1再判断下A1是不是为空，如果空则列取1，不为空则取2。。

left369

xdragon 发表于 2014-9-30 13:18
你想要简单点也可以，就是定位最后一个单元格所在列+1，如果是A1再判断下A1是不是为空，如果空则列取1，不 ...

在哪里改的。可否再改下。

xdragon

Sub test()
    Dim arr, brr$(999), ar, i%, re$(999, 0), cnt%, lastcol%, rng As Range
    For i = 0 To 999
       brr(i) = i
    Next
    arr = Sheets("sheet1").Range("DE1").CurrentRegion.Value
    For Each ar In arr
       brr(ar) = ""
    Next
    For i = 0 To 999
       If brr(i) <> "" Then re(cnt, 0) = Format(brr(i), "'000"): cnt = cnt + 1
    Next
    Set rng = Sheets("sheet2").Cells.SpecialCells(xlCellTypeLastCell)
    If rng.Column = 1 And Len(rng) = 0 Then lastcol = 1 Else lastcol = rng.Column + 1
    Sheets("sheet2").Cells(1, lastcol).Resize(cnt, 1) = re
End Sub