如何监控某个区域的数值并复制到某一列？

airwenlee

监控新数据.rar (7.12 KB, 下载次数: 4)

2018-3-15 00:11 上传

点击文件名下载附件

希望二类13，二类14等二类数据输入后，G列和H列可以自动生成新数据
如果G列H列不可以自动生成新数据，下拉填充或VBA函数也可以接受


百度出来下面代码不能自动监视生成新数据，而且只可以生成一列二类数据，如果修改下可以按我的要求在G列和H列对应生成一类二类数据也行



Sub 按出现次数排序()
  Dim d As Object
  Dim Arr
  Dim i As Integer, j As Integer
  Application.ScreenUpdating = False
  
  '提取不重复值并计算出现次数
  Set d = CreateObject("Scripting.Dictionary")
  Arr = Range("A1:E10")
  For i = 1 To UBound(Arr, 1)
  For j = 1 To UBound(Arr, 2)
  If Not d.Exists(Arr(i, j)) Then
  d.Add Arr(i, j), 1
  Else
  d.Item(Arr(i, j)) = d.Item(Arr(i, j)) + 1
  End If
  Next
  Next
  
  '输出并排序
  Range("G2").Resize(d.Count) = Application.Transpose(d.keys)
  Range("H2").Resize(d.Count) = Application.Transpose(d.items)
  Range("G2:H2").Resize(d.Count).Sort key1:=Range("H2"), Order1:=xlDescending
  
  Set d = Nothing
  Application.ScreenUpdating = True
End Sub

wangg913

问题往往不是多麻烦，最怕看不懂说的是什么。

mmlzh

类似问题论坛是有不少，用两条INDEX+SMALL+IF套路就可以轻松解决

mmlzh

wangg913 发表于 2018-3-15 09:02
问题往往不是多麻烦，最怕看不懂说的是什么。

类似二维转一维，G列是抬头，H列是表内容，题意都得猜猜猜，呵呵

mmlzh

附件用不了，数组公式G1

1. =INDEX($1:$1,SMALL(IF($A$2:$E$99<>"",COLUMN($A:$E),99),ROW(1:1)))&""

复制代码

H1

1. =OFFSET($A$1,RIGHT(SMALL(IF($A$2:$E$99<>"",COLUMN($A:$E)/1%+ROW($1:$8),9999),ROW(1:1)),2),SMALL(IF($A$2:$E$99<>"",COLUMN($A:$E),99),ROW(1:1))-1)&""

复制代码

或

1. =INDIRECT(TEXT(MOD(SMALL(IF($A$2:$E$99<>"",COLUMN($A:$E)/1%%+ROW($2:$99)/1%+COLUMN($A:$E),999999),ROW(1:1)),10^4),"r0c00"),)&""

复制代码

airwenlee

mmlzh 发表于 2018-3-15 09:30
附件用不了，数组公式G1
H1
或

多谢帮忙，代码可以达到我的要求