[已解决]请帮忙修改下面这段代码

jiangslly

Sub huizongrenshu()
   Dim rng As Range, r As Integer
   Dim d As Integer
   Application.ScreenUpdating = False
   For I = 3 To 150
   Sheet4.Select
        Set rng = Sheet12.Cells(I, 2)
        For r = 3 To 18
          d = 0
         If rng.Value = Sheet4.Cells(r, 1).Value Then
           d = d + 1
        
         End If
         Next
            Cells(r, 25).Value = d
        Next
    Set rng = Nothing
End Sub
是这样子，我有一张工资表，以及一张汇总表，我现在要两张表上同一字段（部门）进行查找，如果相同，就加1，最后汇总到汇总工资表中
具体见附件，上面的代码我运行之后都是1，不知道问题存在哪里，请高手帮忙修改下，谢谢具体见附件

最佳答案

月排行榜 / 总排行榜

1970-1-1 08:00

跳转到最佳答案楼层

Select

1. 
   
2. Sub huizongrenshu()
   
3.     Dim i As Integer, j As Integer, s As Integer
   
4.     With Sheet4
   
5.         For i = 3 To 18    '遍历部门
   
6.             For j = 3 To 150    '遍历一级部门
   
7.                 If .Cells(i, 1) = Sheet12.Cells(j, 2) Then s = s + 1
   
8.             Next j
   
9.             .Cells(i, 25) = s
   
10.             s = 0
    
11.         Next i
    
12.     End With
    
13. End Sub

复制代码

工资计算模板b.rar (23.2 KB, 下载次数: 3)

2011-8-13 10:16 上传

点击文件名下载附件 是这样吗

laosanjie

回复 jiangslly 的帖子

Sub huizongrenshu()
    Dim rng As Range, rng2 As Range, r As Byte, k As Byte
    Dim x%
    Application.ScreenUpdating = False
    x = Sheet12.[B65536].End(3).Row
    For I = 3 To x
        Sheet4.Select
        Set rng = Sheet12.Cells(I, 2)
        Set rng2 = Range("A1:A18").Find(rng, lookat:=xlWhole)
        k = rng2.Row
        For r = 3 To 18
            ' d = 0
            If rng.Value = Sheet4.Cells(r, 1).Value Then
                'd = d + 1
                Cells(k, 25).Value = Cells(k, 25).Value + 1
            End If
        Next
    Next
    Set rng = Nothing
    Set rng2 = Nothing
End Sub

无聊的疯子

回复 jiangslly 的帖子

你的d =0 放错地方了
For r = 3 To 18
d = 0  每循环一次，D都=0，这时候你的值还没写进单元格
If rng.Value = Sheet4.Cells(r, 1).Value Then
d = d + 1
End If
Next

For I = 3 To 150
Sheet4.Select
Set rng = Sheet12.Cells(I, 2)
d = 0    放在这上面就行了
For r = 3 To 18

If rng.Value = Sheet4.Cells(r, 1).Value Then
d = d + 1

End If
Next
Cells(r, 25).Value = d
Next
Set rng = Nothing

无聊的疯子

回复 jiangslly 的帖子

测试了一下代码，感觉用这个公式还简单些

Y3 =COUNTIF('加工厂工资表 (2)'!B:B,A3)

直接下拉
如果非要用VBA的话，看看下面的代码是不是一样的结果？？

1. Sub huizongrenshu()
   
2. arr = Sheet4.Range("A3:A18")
   
3. For x = 1 To UBound(arr)
   
4. arr(x, 1) = IIf(Application.CountIf(Sheet12.Range("B:B"), arr(x, 1)) = 0, "'", Application.CountIf(Sheet12.Range("B:B"), arr(x, 1)))
   
5. Next
   
6. Sheet4.Range("Y3:Y18").Value = arr
   
7. End Sub

复制代码

jiangslly

回复 Select 的帖子

谢谢你，但是现在还存在个问题，当我对工资表第三列进行查找统计的时候，前面的全部变为零了，因汇总表中有些是一级部门，有些是二级部门，我需要把这些都统计起来，能改进下吗

jiangslly

回复 Select 的帖子

Sub huizongrenshu2()
    Dim i As Integer, j As Integer, s As Integer
    With Sheet4
    s = 0
      Range(Cells(3, 25), Cells(18, 25)).ClearContents
      
        For i = 3 To 18    '遍历部门
            For j = 3 To 150    '遍历一级部门
         
                If .Cells(i, 1) = Sheet12.Cells(j, 3) Then s = s + 1
                  
            Next j
            .Cells(i, 25) = s
             If .Cells(i, 1) <> Sheet12.Cells(j, 3) Then _
                  .Cells(i, 25).Value = .Cells(i, 25).Value
        Next i
    End With
End Sub
我把代码改成这样，发现还是不能把一级部门人数跟二级部门人数分开

jiangslly

回复 无聊的疯子 的帖子

大师，谢谢你
你说的那种思路我还要仔细研究，其实我知道这种用函数最简单，但是我目前在学习阶段，所以什么方法都要去尝试，
因为汇总工资表中有一级部门也有二级部门，这要陆续查找工资表中第二列与第三列，代码如下：
Sub huizongrenshu2()
    Dim i As Integer, j As Integer, s As Integer
    With Sheet4
    s = 0
      Range(Cells(3, 25), Cells(18, 25)).ClearContents
      
        For i = 3 To 18    '遍历部门
            For j = 3 To 150    '遍历一级部门
         
                If .Cells(i, 1) = Sheet12.Cells(j, 3) Then s = s + 1
                  
            Next j
            .Cells(i, 25) = s
             If .Cells(i, 1) <> Sheet12.Cells(j, 3) Then _
                  .Cells(i, 25).Value = .Cells(i, 25).Value
        Next i
    End With
End Sub
但是问题是当我运行统计二级部门的时候，一级部门的数字也出来了，而且同上一行的数据相同，但是当我汇总通过字段查找汇总工资数据的时候，却不会出现这样的问题：代码如下：
Sub huizongshuju()
       Dim i As Integer, r As Integer, d As Integer, e As Integer
    Dim rng As Range
    Sheet4.Range("B3:Z19").ClearContents
   Application.ScreenUpdating = False
    If MsgBox("确定要汇总部门工资数据吗？", vbYesNo + 32, "系统提示") = vbNo Then _
       Exit Sub
    End If
    For i = 3 To 150
        Sheet4.Select
        Set rng = Sheet12.Cells(i, 3)
        For r = 3 To 18
            For d = 2 To 24
                If rng.Value = Sheet4.Cells(r, 1).Value Then
                    Cells(r, d).Value = Val(Cells(r, d).Value) + rng.Offset(, 3 + d).Value
             End If
           
            Next
        Next
    Next
      Application.ScreenUpdating = True
         
End Sub
我就是不知道这其中的差别在哪里，请指教，具体见附件

Select

1. 
   
2. Sub huizongrenshu2()
   
3.     Dim i As Integer, j As Integer, s As Integer
   
4.     With Sheet4
   
5.         s = 0
   
6.         Range(Cells(3, 25), Cells(18, 25)).ClearContents
   
7.         For i = 3 To 18    '遍历部门
   
8.             For j = 3 To 150    '遍历一级部门
   
9.                 If .Cells(i, 1) = Sheet12.Cells(j, 3) Then
   
10.                     s = s + 1
    
11.                 End If
    
12.             Next j
    
13.             .Cells(i, 25) = s
    
14.             '汇总表最大18行，工作表最大150行，这样比是什么意义？
    
15.             If .Cells(i, 1) <> Sheet12.Cells(j, 3) Then
    
16.                 '单元格Cells(i, 25)的值赋给单元格Cells(i, 25)，是什么意义？
    
17.                 .Cells(i, 25).Value = .Cells(i, 25).Value
    
18.             End If
    
19.         Next i
    
20.     End With
    
21. End Sub

复制代码

不明白IF语句的作用和含义

无聊的疯子

回复 jiangslly 的帖子

Sub huizongrenshu2()中的   If sheet4.Cells(i, 1) = Sheet12.Cells(j, 3) 这个没有成立的等式

因为的数据里，一级部门和二级部门是分开的两列，他们是一个关系式，而不是一个等式

我觉得你还是重新整理一下你的要求，重新说明一下，直接给你写个代码算了！！如果你是想研究代码的话，这样给你讲太累了，你可以自己少拿点数据，先用代码写一个功能，然后再写第二个功能，这样比较容易学习！