Excel精英培训网

 找回密码
 注册
数据透视表40+个常用小技巧,让你一次学会!
查看: 2492|回复: 5

[已解决]问题出在那里

[复制链接]
发表于 2015-1-13 20:09 | 显示全部楼层 |阅读模式
本帖最后由 mmc998 于 2015-1-14 06:34 编辑

Sub test()
    Dim arr, i%, j%
   arr = Sheet1.Range("a1:ap" & Sheet1.Cells(Rows.Count, 1).End(xlUp).Row)
For i = 3 To UBound(arr)
        For j = 8 To UBound(arr, 2)
            arr(i, j) = IIf(arr(i, 1) = arr(1, j) Or arr(i, 2) = arr(1, j) Or arr(i, 3) = arr(1, j) Or arr(i, 4) = arr(1, j) Or arr(i, 5) = arr(1, j), 0, arr(i - 1, j) + 1)
        Next
    Next
    With Sheet2
        .UsedRange.ClearContents
        .[a1].Resize(i - 1, j - 1) = arr
    End With
    MsgBox "处理完毕!", , "提示"
End Sub
最佳答案
2015-1-13 23:50
Option Explicit

Sub test()
    Dim arr, i, j, k
    Sheets("Sheet2").Select
    arr = Range("a1:ap" & Cells(Rows.Count, 1).End(xlUp).Row)
    For i = 3 To UBound(arr)
        For j = 8 To UBound(arr, 2)
            'arr(i, j) = IIf(arr(i, 1) = arr(1, j) Or arr(i, 2) = arr(1, j) Or arr(i, 3) = arr(1, j) Or arr(i, 4) = arr(1, j) Or arr(i, 5) = arr(1, j), 0, arr(i - 1, j) + 1)


            '1)先假设条件不等于,即arr(i,j)=arr(i,j)
            arr(i, j) = arr(i - 1, j) + 1
            '2)判断arr(i,j)与本行前6列各值是否相等
            For k = 2 To 6
                If arr(1, j) = arr(i, k) Then
                    '3)一旦相等,arr(i,j)=0,结束判断
                    arr(i, j) = 0
                    Exit For
                End If
            Next k
        Next j
    Next i
    With Sheets("Sheet2")
        '        .UsedRange.ClearContents
        .[a1].Resize(UBound(arr), UBound(arr, 2)) = arr
    End With
    MsgBox "处理完毕!", , "提示"
End Sub

Book大遗3.rar (222.81 KB, 下载次数: 13)
excel精英培训的微信平台,每天都会发送excel学习教程和资料。扫一扫明天就可以收到新教程
 楼主| 发表于 2015-1-13 20:09 | 显示全部楼层
Book大遗.rar (278.31 KB, 下载次数: 21)
回复

使用道具 举报

发表于 2015-1-13 22:01 | 显示全部楼层
没说明?至少应该把问题描述一下,别人不好猜,求助就更难解决。
回复

使用道具 举报

 楼主| 发表于 2015-1-13 22:15 | 显示全部楼层
爱疯 发表于 2015-1-13 22:01
没说明?至少应该把问题描述一下,别人不好猜,求助就更难解决。

ao,ap列,错误多
回复

使用道具 举报

 楼主| 发表于 2015-1-13 22:39 | 显示全部楼层
爱疯 发表于 2015-1-13 22:01
没说明?至少应该把问题描述一下,别人不好猜,求助就更难解决。

f 列数据没出来
回复

使用道具 举报

发表于 2015-1-13 23:50 | 显示全部楼层    本楼为最佳答案   
Option Explicit

Sub test()
    Dim arr, i, j, k
    Sheets("Sheet2").Select
    arr = Range("a1:ap" & Cells(Rows.Count, 1).End(xlUp).Row)
    For i = 3 To UBound(arr)
        For j = 8 To UBound(arr, 2)
            'arr(i, j) = IIf(arr(i, 1) = arr(1, j) Or arr(i, 2) = arr(1, j) Or arr(i, 3) = arr(1, j) Or arr(i, 4) = arr(1, j) Or arr(i, 5) = arr(1, j), 0, arr(i - 1, j) + 1)


            '1)先假设条件不等于,即arr(i,j)=arr(i,j)
            arr(i, j) = arr(i - 1, j) + 1
            '2)判断arr(i,j)与本行前6列各值是否相等
            For k = 2 To 6
                If arr(1, j) = arr(i, k) Then
                    '3)一旦相等,arr(i,j)=0,结束判断
                    arr(i, j) = 0
                    Exit For
                End If
            Next k
        Next j
    Next i
    With Sheets("Sheet2")
        '        .UsedRange.ClearContents
        .[a1].Resize(UBound(arr), UBound(arr, 2)) = arr
    End With
    MsgBox "处理完毕!", , "提示"
End Sub

Book大遗3.rar (222.81 KB, 下载次数: 13)
回复

使用道具 举报

您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|Archiver|Excel精英培训 ( 豫ICP备11015029号 )

GMT+8, 2024-3-29 14:54 , Processed in 1.245813 second(s), 10 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

快速回复 返回顶部 返回列表