忽略空格求生克值的自定义函数

lss001 · 发表于 2018-11-10 22:37

本帖最后由 lss001 于 2018-11-12 17:13 编辑

1 组三-1.zip (1.32 MB, 下载次数: 12)

WYS67 · 发表于 2018-11-10 23:51

lss001 发表于 2018-11-10 22:37
详细见附件！！！

老师：代码存在两个问题：
1.如本表C1的10000为《00 总表》数据最后行，H2为符合条件的数据最后行4126，则E4126的10000是《组三》最后序号，J4127代表符合条件的数据最后行与C1指定的全部数据最后行之差--也就是当前遗漏，其当前遗漏公式为:=$C$1-INDIRECT("E"&$H$2)，计算结果显示在"J"&(H2+1)单元格中。
2.《中位 1》~《中位 6》的I1代表指定中位，《中位 1》提取《总表》K5:K6565里为1的中位，《中位 2》提取《总表》K5:K6565里为2的中位，《中位 3》提取《总表》K5:K6565里为3的中位，......《中位 6》提取《总表》K5:K6565里为6的中位才对；可是，代码计算结果除《中位 1》和《中位 2》正确外，《中位 3》~《中位 6》提取的都是中位为2的数据，没有按照要求提取对应的3~6的中位。

1 组三.zip (522.78 KB, 下载次数: 7)

WYS67 · 发表于 2018-11-11 09:56

本帖最后由 WYS67 于 2018-11-11 10:06 编辑

lss001 发表于 2018-11-10 22:37
详细见附件！！！

老师：上面是《1 组三》中位和《2 组六》数型所有分类提取的模拟结果。要求修改后的代码复制粘贴进《1 组三》或《2 组六》的模块1后，当点击【总表】里的按钮时，能够自动提取《中位 1》~《中位 6》或《数型 0》~《数型 5》的所有数据，并能在J列自动显示历史遗漏和当前遗漏的计算结果。

两个工作表，一个是《中位》，一个是《数型》，可以把《总表》K4的名称当作检索查询的指定条件使用。

1 组三.zip (654.54 KB, 下载次数: 6)

2 组六.zip (770.91 KB, 下载次数: 19)

怎样把同一个代码复制粘贴进《1 组三》和《2 组六》里，点击按钮，便能自动提取《中位 1》~《中位 6》或《数型 0》~《数型 5》的所有数据，并自动在J列自动显示历史遗漏和当前遗漏的计算结果？

WYS67 · 发表于 2018-11-11 11:14

本帖最后由 WYS67 于 2018-11-11 11:34 编辑

lss001 发表于 2018-11-10 22:37
详细见附件！！！

老师：代码应用到《2 组六》的数型时出错。
能不能让代码里的“中位”和“数型”调用《总表》K4里的内容？这样无论“中位”和“数型”或其它内容，都能运算。

Sub 拆分数型()
Dim ar, br, g, h, s, t, i, j, k, x, y
h = Sheets("总表").Cells(1, "h") - 4
ar = Sheets("总表").Range("e5:k" & h + 4)
g = UBound(ar, 2) - 1
For k = h To 1 Step -1
      If ar(k, 1) <> "" Then Exit For
Next
For y = 1 To Worksheets.Count - 1
      x = 0: ReDim br(1 To k, 1 To g)
      For i = 1 To k
         If ar(i, 7) = y Then
            x = x + 1
            For j = 1 To g
                  If j < 6 Then
                     br(x, j) = ar(i, j)
                  Else
                     If x = 1 Then
                        br(x, j) = br(x, 1) - 4
                     Else
                        br(x, j) = br(x, 1) - br(x - 1, 1)
                     End If
                  End If
            Next
         End If
      Next
      br(x + 1, g) = ar(k, 1) - br(x, 1)
      s = Sheets("数型 " & y & "").Cells(1, "h") - 3
      Sheets("数型 " & y & "").Cells(5, "e").Resize(s, 6) = br
      Erase br
Next
End Sub

2 组六.zip (928.97 KB, 下载次数: 3)

WYS67 · 发表于 2018-11-11 12:03

本帖最后由 WYS67 于 2018-11-11 12:10 编辑

lss001 发表于 2018-11-11 11:39
附件再次更正
→→请重新下载22楼2个附件！
注意2个附件都有更正！！！

已下载。经测试，以下需修正或改进：
1.《2 组六》《数型 0》~《数型 5》J列最后的当前遗漏比实际数据都少1个数；

改进之处：
1.按钮名称：就是代码第一行的 Sub 拆分数型 修改为 Sub 拆分K列
2.把下面代码里的“数型”改为引用《总表》K4单元格里的名称，《2 组六》总表!K4里是“数型”，《1 组三》总表!K4里是“中位”；如果在代码里调用总表!K4的内容，是不是《1 组三》就能和《2 组六》的代码合二为一，变成通用的了？
s = Sheets("数型 " & y & "").Cells(1, "h") - 4 '***
      Sheets("数型 " & y & "").Cells(5, "e").Resize(s, 6) = br '***
      If x >= s - 4 Then
         Sheets("数型 " & y & "").Cells(s + 1, "j") = ar(k, 1) - br(s - 4, 1) '***
      Else
         Sheets("数型 " & y & "").Cells(x + 5, "j") = ar(k, 1) - br(x, 1) '***
3.在代码里注明条件列标，如《1 组三》和《2 组六》的条件列标为总表!K。这样，即使其他工作簿里的条件列标不是总表!K，而是总表!L或其他列标，只需修改一下条件列标就可以自动运行代码，显示想要达到的结果了！

WYS67 · 发表于 2018-11-11 13:38

lss001 发表于 2018-11-11 12:58
22楼附件改为通用型！
可用于组三，组六，三同！
请重新下载22楼附件！

嗯。问题1、2已圆满解决！

在各个分表里增加J1指定为《总表》的条件列标参数。
《1 组三》的【中位 1】~【中位 6】的J1为《总表》的条件列标，使代码提取符合条件的《总表》E:I列数据，这样更方便随时提取当条件在其它列时的数据。
比如《1 组三》的K:N列用于其他计算，O列为《总表》条件列标，只需指定《1 组三》的【中位 1】~【中位 6】的J1为“O”，点击《总表》里的拆分按钮，就能自动拆分符合条件的E:I列数据到对应分表中。

1 组三 (3).zip (521.45 KB, 下载次数: 17)

2 组六 (3).zip (639.97 KB, 下载次数: 5)

WYS67 · 发表于 2018-11-11 14:01

lss001 发表于 2018-11-11 13:25
22楼再更新！
增加当改变条件不为K列时的修改说明！

测试了您最后修改的两个附件，感觉31楼指定各分表J1为条件列标参数的方法更简单明了，容易操作。恳请老师按31楼里的要求修改代码。

玉阳山人 · 发表于 2018-11-11 15:27

lss001 发表于 2018-11-11 14:50
附件还是在22楼，条件列更改为各分表J1指定！！！

谢谢老师！

WYS67 · 发表于 2018-11-12 12:51

lss001 发表于 2018-11-10 22:37

下面的《1 组三》里多了《标准》、《1 中位号》、《2 号码》和《3 号隔》4个工作表，导致点击“拆分K列”按钮时，运行22楼代码就会出现上面的错误。

怎样修改代码，才能使“拆分K列”不受其它工作表影响，把《总表》里K列数据拆分到对应的《中位 1》~《中位 6》里？

1 组三.zip (1.38 MB, 下载次数: 4)

WYS67 · 发表于 2018-11-12 15:32

本帖最后由 WYS67 于 2018-11-12 15:46 编辑

lss001 发表于 2018-11-10 22:37

老师：最新代码怎么无法把《2 组六》K列等于3、4、5的数据，拆分到对应的《数型 3》、《数型 4》和《数型 5》里？里面的数据怎么和《数型 0》完全相同？
35楼的代码为通用代码，可以按《1 组三》和《2 组六》总表!K列的条件，自动把《总表》E:I列的数据拆分到对应的《中位 *》和《数型 *》里。新代码怎么不通用了呢？

2 组六.zip (747.28 KB, 下载次数: 7)

		自动登录	找回密码
密码			免费注册

[求助] 忽略空格求生克值的自定义函数

评分