[已解决]动态的循环怎么设置？

凤鸣岐山 · 发表于 2024-2-13 20:39

先用for循环计算2015-2023年各种鸟的数量，表内蓝框数据正确。再想统计2015年-2023年的新鸟数量，单独计算其中某一年的简单，只需要改一下当年的数据单元，但是统计这几年的，好像复杂了，原来逐句判断当前列前的每一项是否为零，我设了一个循环，但是统计出的数据不对，不知道问题出在哪里。红框H列存放新鸟数据，请老师们给予指导。

最佳答案

月排行榜 / 总排行榜

砂海

2024-2-19 15:24

凤鸣岐山发表于 2024-2-18 20:40
老师好，H 列红框里的数据是正确值
86
55

With Sheet2 With Sheets"分类统计" 直观
===================================
单元格用颜色来操作的方法不推荐
重新写的, 按手册号操作的

①【分类统计】89 行扇尾沙锥的手册号应该是错了
② 空白的 , 增加了几个, 算修改了数据源

======================================
' 供参考
Sub 综合统计_多年()
Dim 列序_arr0, 鸟分类_arr0, 数据源_arr0, 结果_arr9(1 To 1000, 1 To 20), r0&, c0&
Dim i&, j&, k&, 鸟分类$, 列9&
Dim D_列序, D_鸟分类, D_发现
Dim t

t = Timer
Set D_列序 = CreateObject("scripting.dictionary")
Set D_鸟分类 = CreateObject("scripting.dictionary")
Set D_发现 = CreateObject("scripting.dictionary")

With ThisWorkbook
      With .Sheets("综合统计")
         列序_arr0 = .Range("B22:G22").Value
      End With

      For i& = 1 To UBound(列序_arr0, 2)
         D_列序(列序_arr0(1, i&)) = i&
      Next i&

      With .Sheets("手册鸟名录")
         鸟分类_arr0 = .Range("B3:F" & .Range("B3").End(xlDown).Row).Value
      End With

      For i& = 1 To UBound(鸟分类_arr0)
         D_鸟分类(鸟分类_arr0(i&, 1)) = 鸟分类_arr0(i&, 5)
      Next i&

      With .Sheets("分类统计")
         r0& = .Range("g65536").End(xlUp).Row
         c0& = .Range("IV2").End(xlToLeft).Column - 1
         数据源_arr0 = .Range("A1").Resize(r0&, c0&).Value
      End With

      For i& = 9 To c0& Step 3
         k& = k& + 1
         结果_arr9(k&, 1) = Left(数据源_arr0(2, i&), 4)    '年份
'          Stop
         For j& = 4 To r0&
            If 数据源_arr0(j&, i& + 1) <> 0 Then '有数据 (出现地点)

                  鸟分类$ = D_鸟分类(数据源_arr0(j&, 6))
                  列9& = D_列序(鸟分类$) + 1

                  If D_发现.Exists(数据源_arr0(j&, 6)) = False Then
                     '新拍
                     D_发现(数据源_arr0(j&, 6)) = 1 '
'                      If i& = 18 Then Debug.Print 数据源_arr0(j&, 6)
                     结果_arr9(k&, 8) = 结果_arr9(k&, 8) + 1    '新拍鸟
                     结果_arr9(1000, 列9&) = 结果_arr9(1000, 列9&) + 1 '新拍鸟行累计

                  End If

                  结果_arr9(k&, 列9&) = 结果_arr9(k&, 列9&) + 1 '年度&分类 +1
                  结果_arr9(k&, 9) = 结果_arr9(k&, 9) + 1 '年度小计 +1

            End If
         Next j&
      Next i&

      k& = k& + 1
      结果_arr9(k&, 1) = "累计新鸟种数"
      For i& = 2 To 10
         结果_arr9(k&, i&) = 结果_arr9(1000, i&)
      Next i&
'       .Sheets("综合统计").Range("A24").Resize(1000, 12).Clear
      .Sheets("综合统计").Range("A24").Resize(k&, 11).Value = 结果_arr9
      .Sheets("综合统计").Select
'       Stop

End With
Debug.Print "用时 " & Timer - t & "秒"
End Sub

跳转到最佳答案楼层

砂海 · 发表于 2024-2-17 16:09

无效内容太多.

屏蔽其它内容 , 针对本贴问题
1. 数据源是?
2. 程序是 ?
3. 结果哪个值不对 , ( 举例到具体单个单元格 , 正确值又应该是什么?)

=============================================

假设本帖问题的数据源是"拍鸟清单"
那么 2016 猛禽只有

100	455	鹗	16/4/8
105	512	燕隼	16/5/3

单元格 G25 应该是 2

如果 "拍鸟清单" 是数据源 , 那么所有的鸟只有出现过一次 , 没有再次发现

凤鸣岐山 · 发表于 2024-2-18 19:38

老师好，这是求“分类统计”表里各年份数据的汇总，对应的是下边： Sub 统计2024修改计算综合表换色后各年品种()。可能是设置循环变量有问题，统计出来的结果不对。

凤鸣岐山 · 发表于 2024-2-18 20:40

老师好，H 列红框里的数据是正确值
86
55
30
10
7
14
13
15
18
。执行程序是： Sub 统计2024修改计算综合表换色后各年品种()

砂海 · 发表于 2024-2-19 15:24

凤鸣岐山发表于 2024-2-18 20:40
老师好，H 列红框里的数据是正确值
86
55

With Sheet2 With Sheets"分类统计" 直观
===================================
单元格用颜色来操作的方法不推荐
重新写的, 按手册号操作的

①【分类统计】89 行扇尾沙锥的手册号应该是错了
② 空白的 , 增加了几个, 算修改了数据源

======================================
' 供参考
Sub 综合统计_多年()
Dim 列序_arr0, 鸟分类_arr0, 数据源_arr0, 结果_arr9(1 To 1000, 1 To 20), r0&, c0&
Dim i&, j&, k&, 鸟分类$, 列9&
Dim D_列序, D_鸟分类, D_发现
Dim t

t = Timer
Set D_列序 = CreateObject("scripting.dictionary")
Set D_鸟分类 = CreateObject("scripting.dictionary")
Set D_发现 = CreateObject("scripting.dictionary")

With ThisWorkbook
      With .Sheets("综合统计")
         列序_arr0 = .Range("B22:G22").Value
      End With

      For i& = 1 To UBound(列序_arr0, 2)
         D_列序(列序_arr0(1, i&)) = i&
      Next i&

      With .Sheets("手册鸟名录")
         鸟分类_arr0 = .Range("B3:F" & .Range("B3").End(xlDown).Row).Value
      End With

      For i& = 1 To UBound(鸟分类_arr0)
         D_鸟分类(鸟分类_arr0(i&, 1)) = 鸟分类_arr0(i&, 5)
      Next i&

      With .Sheets("分类统计")
         r0& = .Range("g65536").End(xlUp).Row
         c0& = .Range("IV2").End(xlToLeft).Column - 1
         数据源_arr0 = .Range("A1").Resize(r0&, c0&).Value
      End With

      For i& = 9 To c0& Step 3
         k& = k& + 1
         结果_arr9(k&, 1) = Left(数据源_arr0(2, i&), 4)    '年份
'          Stop
         For j& = 4 To r0&
            If 数据源_arr0(j&, i& + 1) <> 0 Then '有数据 (出现地点)

                  鸟分类$ = D_鸟分类(数据源_arr0(j&, 6))
                  列9& = D_列序(鸟分类$) + 1

                  If D_发现.Exists(数据源_arr0(j&, 6)) = False Then
                     '新拍
                     D_发现(数据源_arr0(j&, 6)) = 1 '
'                      If i& = 18 Then Debug.Print 数据源_arr0(j&, 6)
                     结果_arr9(k&, 8) = 结果_arr9(k&, 8) + 1    '新拍鸟
                     结果_arr9(1000, 列9&) = 结果_arr9(1000, 列9&) + 1 '新拍鸟行累计

                  End If

                  结果_arr9(k&, 列9&) = 结果_arr9(k&, 列9&) + 1 '年度&分类 +1
                  结果_arr9(k&, 9) = 结果_arr9(k&, 9) + 1 '年度小计 +1

            End If
         Next j&
      Next i&

      k& = k& + 1
      结果_arr9(k&, 1) = "累计新鸟种数"
      For i& = 2 To 10
         结果_arr9(k&, i&) = 结果_arr9(1000, i&)
      Next i&
'       .Sheets("综合统计").Range("A24").Resize(1000, 12).Clear
      .Sheets("综合统计").Range("A24").Resize(k&, 11).Value = 结果_arr9
      .Sheets("综合统计").Select
'       Stop

End With
Debug.Print "用时 " & Timer - t & "秒"
End Sub

砂海 · 发表于 2024-2-19 15:41

PS
本来打算用中文鸟名,
但 vba 有文字不能识别 , 如蚁 " 䴕 "

凤鸣岐山 · 发表于 2024-2-22 18:43

砂海发表于 2024-2-19 15:41
PS
本来打算用中文鸟名,
但 vba 有文字不能识别 , 如蚁 " 䴕 "

老师的方法按规矩来的，条理更清晰，大概意思明白了，还需要再消化。
我跑了一下，能够跑通，数据有一点出入，可能是因为手册序号，手册名录是前些年的出版物，近些年陆续出现的鸟种，或者是新独立出来的鸟种，所以在分类统计表里就出现空白，造成序号不连续。
谢谢老师指导！

砂海 · 发表于 2024-2-25 10:34

凤鸣岐山发表于 2024-2-22 18:43
老师的方法按规矩来的，条理更清晰，大概意思明白了，还需要再消化。
我跑了一下，能够跑通，数据 ...

手册序号随版本不同的话, 或许该把手册名也带上
才能实现数据稳定可靠

个人觉得数据源长这样, 结构简单 , 方便后续的统计与计算

07 版 excel 表格超过 100万行, 数据量超过这个可以考虑数据库
excel 有太多的的单元格格式 , 导致表格无效膨胀

凤鸣岐山 · 发表于 2024-3-5 20:53

砂海发表于 2024-2-25 10:34
手册序号随版本不同的话, 或许该把手册名也带上
才能实现数据稳定可靠

老师好，我就是自己使用，数据量不大，但是每年都是这样重复，用不到数据库。

砂海 · 发表于 2024-3-13 21:37

凤鸣岐山发表于 2024-3-5 20:53
老师好，我就是自己使用，数据量不大，但是每年都是这样重复，用不到数据库。

...
假设 20年 , 50年 , 80年 .... 后 ,
对这些数据进行分析的话 , 手册改了几版的话 , 只有序号就麻烦了

==========
据我所知, 生物学有些分类意见不统一

轮虫分类形态结构特殊，长期以来其分类地位各家意见不统一。多将其列为线形动物门Nemathelminthes的-·个纲，即轮虫纲 Rotifera。有的学者把这类假体整动物称为原体脖动物门Aschelminthes。现在很多学者将轮虫单独列为轮虫动物门 Phylum Rotifera。按照

也许鸟类没这些事 , 但凡事就拍万一

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