[已解决]哪里写错了

shwanghuafeng

Sub 索引()
  Dim i
  Sheet1.Select
  Sheet1.Range("A2:A" & [A65536].End(3).Row).AdvancedFilter 2, , Sheet2.Range("A1"), True
  Sheet2.Select
    For i = 1 To Sheet2.Cells(65536, 1).End(3).Row
      Sheet2.Cells(i, 2) = WorksheetFunction.CountIf(Sheet1.Range("A:A"), Sheet2.Cells(i, 1))
    Next
End Sub

结果总是会重复一次

最佳答案

月排行榜 / 总排行榜

橘子红

2015-12-26 15:02

是要选择sheet1的A列的最后一个非空单元格,不写就默认活动工作表sheet2的最后一行了,arr就等于  sheet2的 [a1:a2]了,改成下面的

Sub 改进索引()
  Dim i, d, arr, brr
  Set d = CreateObject("Scripting.Dictionary")
  arr = Sheet1.Range("A2:A" & Sheet1.[A65536].End(3).Row)
  For i = 1 To UBound(arr)
    d(arr(i, 1)) = d(arr(i, 1)) + 1
  Next
  Sheet2.Range("A1").Resize(d.Count, 1) = Application.Transpose(d.keys)
  Sheet2.Range("B1").Resize(d.Count, 1) = Application.Transpose(d.items)
'  For i = 1 To d.Count
'    Sheet2.Cells(i, 2) = d(Sheet2.Cells(i, 1))
'  Next
End Sub

跳转到最佳答案楼层

橘子红

把第一个数据当初标题了应该

橘子红

看了下,工作表里的高级筛选好像也没有地方可以设置包不包含标题行
取唯一值可以用字典呀

shwanghuafeng

橘子红 发表于 2015-12-25 22:35
看了下,工作表里的高级筛选好像也没有地方可以设置包不包含标题行
取唯一值可以用字典呀

谢谢大大，我去百度一下字典怎么用
我尝试预先把sheet2的A1设置一个值，其他不变，结果会提示“提取区域的字段名丢失或非法”

shwanghuafeng

橘子红 发表于 2015-12-25 22:35
看了下,工作表里的高级筛选好像也没有地方可以设置包不包含标题行
取唯一值可以用字典呀

Sub 改进索引()
  Dim i, d, arr, brr
  Set d = CreateObject("Scripting.Dictionary")
  arr = Sheet1.Range("A2:A" & [A65536].End(3).Row)
  For i = 1 To UBound(arr)
    d(arr(i, 1)) = d(arr(i, 1)) + 1
  Next
  Sheet2.Range("A1").Resize(d.Count, 1) = Application.Transpose(d.keys)
  Sheet2.Range("B1").Resize(d.Count, 1) = Application.Transpose(d.items)
'  For i = 1 To d.Count
'    Sheet2.Cells(i, 2) = d(Sheet2.Cells(i, 1))
'  Next
End Sub

这是刚刚改的，因为是现学现卖，遇到三个问题：
1，改后的过程在激活sheet1的时候运行正常，但如果当前激活的是sheet2再运行就会出错（头一次点运行虽结果不正确但能运行，第二次再运行直接提示黄字部分类型不匹配），这是为什么？还有哪些方法需要激活正确的工作表才能正确运行？
2，为了输出到sheet2的数据能一一对应，本来我用的是绿字注释部分而非现在用的蓝字，但是结果为空，应该怎么改？
3，我想将d.keys和d.items合并成一个新的二维数组（元素形如key,item），然后直接输出到相应区域，这个要怎么写？

橘子红

是要选择sheet1的A列的最后一个非空单元格,不写就默认活动工作表sheet2的最后一行了,arr就等于  sheet2的 [a1:a2]了,改成下面的

Sub 改进索引()
  Dim i, d, arr, brr
  Set d = CreateObject("Scripting.Dictionary")
  arr = Sheet1.Range("A2:A" & Sheet1.[A65536].End(3).Row)
  For i = 1 To UBound(arr)
    d(arr(i, 1)) = d(arr(i, 1)) + 1
  Next
  Sheet2.Range("A1").Resize(d.Count, 1) = Application.Transpose(d.keys)
  Sheet2.Range("B1").Resize(d.Count, 1) = Application.Transpose(d.items)
'  For i = 1 To d.Count
'    Sheet2.Cells(i, 2) = d(Sheet2.Cells(i, 1))
'  Next
End Sub

shwanghuafeng

橘子红 发表于 2015-12-26 15:02
是要选择sheet1的A列的最后一个非空单元格,不写就默认活动工作表sheet2的最后一行了,arr就等于  sheet2的 [ ...

原来问题出在这里！能再看一下问题2和3吗？

橘子红

你写的这种输入方式是最快的

shwanghuafeng

虽然结果得到了，但我还是想知道一开始的筛选应该怎么改

shwanghuafeng

橘子红 发表于 2015-12-26 15:02
是要选择sheet1的A列的最后一个非空单元格,不写就默认活动工作表sheet2的最后一行了,arr就等于  sheet2的 [ ...

我查到可以用removeduplicates，试了一下确实可以，但这样岂不是以后每次用这个筛选都要跟一句删除重复值……