[已解决]怎样按sheet2表的m列（现住详细地址）和x列（疾病编号）进行发病地区的统计

gwfzh · 发表于 2010-12-16 17:33

各位老师：由于单位领导新的要求进行发病地区的统计，向各位老师求助了！
要求是在sheet2表的m列（现住详细地址）查找sheet1表的a列的各乡镇单位、如找到的话，则按sheet1表第二行的疾病分类对sheet2表x列（疾病编号）进行发病统计。不知说清楚没有？请帮忙了！

wLMPY7sy.rar (292.71 KB, 下载次数: 26)

白开水的味道 · 发表于 2010-12-16 17:46

不是有现住地编码吗

按照这个不行吗

gwfzh · 发表于 2010-12-17 09:39

QUOTE:

以下是引用白开水的味道在2010-12-16 17:46:00的发言：

不是有现住地编码吗

按照这个不行吗

谢谢老师，可以按现住地址国标编码。整理后按现住地址相对应的国标编码。

jLERNZtA.rar (317.59 KB, 下载次数: 5)

白开水的味道 · 发表于 2010-12-17 10:15

首先你弄的那些编号不全

我弄了了草稿放下面了，点击按钮

EVhgh9NM.rar (323.71 KB, 下载次数: 13)

gwfzh · 发表于 2010-12-17 10:49

QUOTE:

以下是引用白开水的味道在2010-12-17 10:15:00的发言：

首先你弄的那些编号不全

我弄了了草稿放下面了，点击按钮

谢谢白开水的味道老师的帮助！能解释一下语句：
ayy(dr(arr(x, 1)), dc(arr(x, 11))) = ayy(dr(arr(x, 1)), dc(arr(x, 11))) + 1的意思吗？

gwfzh · 发表于 2010-12-17 10:54

或是能注释一下，方便我再学习吗？

Sub 白开水()
    Dim arr, arr1, arr2, ayy(0 To 100, 0 To 100)
    Set sht1 = Sheet1
    Set sht2 = Sheet2
    On Error Resume Next
    i = sht2.Range("a65536").End(xlUp).Row
    arr = sht2.Range("n4:x" & i)                   '将现住地址国标编码和疾病编码输入数组，下边的字典用法不太懂！
    Set dc = CreateObject("scripting.dictionary")
    Set dr = CreateObject("scripting.dictionary")
    For x = 1 To UBound(arr)
        If Not dr.exists(arr(x, 1)) Then
            k = k + 1
            dr.Add arr(x, 1), k
            ayy(k, 0) = arr(x, 1)
        End If
        If Not dc.exists(arr(x, 11)) Then
            m = m + 1
            dc.Add arr(x, 11), m
            ayy(0, m) = arr(x, 11)
        End If
        ayy(dr(arr(x, 1)), dc(arr(x, 11))) = ayy(dr(arr(x, 1)), dc(arr(x, 11))) + 1
    Next
    sht1.[f28].Resize(k, m).ClearContents
    sht1.[f28].Resize(k, m) = ayy
    MsgBox "完成了~"
End Sub

[此贴子已经被作者于2010-12-17 10:55:01编辑过]

白开水的味道 · 发表于 2010-12-17 11:00

QUOTE:

以下是引用gwfzh在2010-12-17 10:49:00的发言：

谢谢白开水的味道老师的帮助！能解释一下语句：
ayy(dr(arr(x, 1)), dc(arr(x, 11))) = ayy(dr(arr(x, 1)), dc(arr(x, 11))) + 1的意思吗？

这个就是统计了

ayy(dr(arr(x, 1)), dc(arr(x, 11))) 这个是位置

白开水的味道 · 发表于 2010-12-17 11:04

QUOTE:

以下是引用gwfzh在2010-12-17 10:54:00的发言：

或是能注释一下，方便我再学习吗？

Sub 白开水()
    Dim arr, arr1, arr2, ayy(0 To 100, 0 To 100)
    Set sht1 = Sheet1
    Set sht2 = Sheet2
    On Error Resume Next   '出错控制
    i = sht2.Range("a65536").End(xlUp).Row    '行号
    arr = sht2.Range("n4:x" & i)                   '将现住地址国标编码和疾病编码输入数组，下边的字典用法不太懂！
    Set dc = CreateObject("scripting.dictionary")  '创建字典
   Set dr = CreateObject("scripting.dictionary")
    For x = 1 To UBound(arr)
        If Not dr.exists(arr(x, 1)) Then    '先判断行就是那个国标地址存在不存在，不存在的话就增加一行，存放国标地址，k是行号
     k = k + 1
            dr.Add arr(x, 1), k
            ayy(k, 0) = arr(x, 1)
        End If
        If Not dc.exists(arr(x, 11)) Then '判断疾病存在不存在，如果不存在就增加一列，存放疾病的，m是列号
         m = m + 1
            dc.Add arr(x, 11), m
            ayy(0, m) = arr(x, 11)
        End If
        ayy(dr(arr(x, 1)), dc(arr(x, 11))) = ayy(dr(arr(x, 1)), dc(arr(x, 11))) + 1    '对每一个出现的地址的疾病进行统计
Next
    sht1.[f28].Resize(k, m).ClearContents '删除区域
sht1.[f28].Resize(k, m) = ayy   '对区域赋值，这个值就是统计的数据
MsgBox "完成了~"
End Sub

白开水的味道 · 发表于 2010-12-17 11:08

请学习搁浅2008的帖子

http://www.excelpx.com/forum.php?mod=viewthread&tid=122428

gwfzh · 发表于 2010-12-17 11:42

QUOTE:

以下是引用gwfzh在2010-12-17 10:54:00的发言：

或是能注释一下，方便我再学习吗？

Sub 白开水()
    Dim arr, arr1, arr2, ayy(0 To 100, 0 To 100)
    Set sht1 = Sheet1
    Set sht2 = Sheet2
    On Error Resume Next
    i = sht2.Range("a65536").End(xlUp).Row
    arr = sht2.Range("n4:x" & i)                   '将现住地址国标编码和疾病编码输入数组，下边的字典用法不太懂！
    Set dc = CreateObject("scripting.dictionary")
    Set dr = CreateObject("scripting.dictionary")
    For x = 1 To UBound(arr)
        If Not dr.exists(arr(x, 1)) Then
            k = k + 1
            dr.Add arr(x, 1), k
            ayy(k, 0) = arr(x, 1)
        End If
        If Not dc.exists(arr(x, 11)) Then
            m = m + 1
            dc.Add arr(x, 11), m
            ayy(0, m) = arr(x, 11)
        End If
        ayy(dr(arr(x, 1)), dc(arr(x, 11))) = ayy(dr(arr(x, 1)), dc(arr(x, 11))) + 1
    Next
    sht1.[f28].Resize(k, m).ClearContents
    sht1.[f28].Resize(k, m) = ayy
    MsgBox "完成了~"
End Sub

能否按照sheet1表第二行的疾病顺序进行统计呢？因为按该程序统计后疾病种类是乱的，要重新整理顺序

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