[已解决]VBA能做到吗？

那么的帅 · 发表于 2011-8-12 16:42

回复 excel白兔的帖子

复件 7月原料及主要材料准-6.rar (43.25 KB, 下载次数: 2)

excel白兔 · 发表于 2011-8-12 19:54

回复那么的帅的帖子

谢谢老师帮助{:021:}

excel白兔 · 发表于 2011-8-12 20:30

回复那么的帅的帖子

老师不好意思您给我做的代码在您做的表里可以是对的放到我这表里怎么就不行呢是不是有些东西还得改改呀老师帮助
我已经把工作表给成我的名字了但是还不行

excel白兔 · 发表于 2011-8-12 20:32

回复那么的帅的帖子

Sub 分类汇总()
Dim ARR3(1 To 22, 1 To 1)
With Sheets("按采购凭证进行汇总(带上物料号）")
      Row1 = .Range("L65536").End(xlUp).Row
      arr1 = .Range("L2:N" & Row1)
      arr2 = .Range("T8:T29")
      For i = 1 To UBound(arr1)
         If arr1(i, 1) <> 0 Then
            Select Case Left(arr1(i, 2), 2)
            Case "P6"
                  s1 = 1
                  T1 = 6
                  For J = s1 To T1
                     If CStr(arr1(i, 1)) = Right(arr2(J, 1), 4) Then
                        ARR3(J, 1) = ARR3(J, 1) + IIf(arr1(i, 3) = "", 0, arr1(i, 3))
                        Exit For
                     End If
                  Next J
            Case "PE"
                  s1 = 7
                  T1 = 12
                  For J = s1 To T1
                     If CStr(arr1(i, 1)) = Right(arr2(J, 1), 4) Then
                        ARR3(J, 1) = ARR3(J, 1) + IIf(arr1(i, 3) = "", 0, arr1(i, 3))
                        Exit For
                     End If
                  Next J
            Case "PS"
                  s1 = 19
                  T1 = 21
                  For J = s1 To T1
                     If CStr(arr1(i, 1)) = Right(arr2(J, 1), 4) Then
                        ARR3(J, 1) = ARR3(J, 1) + IIf(arr1(i, 3) = "", 0, arr1(i, 3))
                        Exit For
                     End If
                  Next J
            Case "PJ"
                  Select Case Mid(arr1(i, 2), 3, 1)
                  Case "C"
                     s1 = 13
                     T1 = 18
                     For J = s1 To T1
                        If CStr(arr1(i, 1)) = Right(arr2(J, 1), 4) Then
                              ARR3(J, 1) = ARR3(J, 1) + IIf(arr1(i, 3) = "", 0, arr1(i, 3))
                              Exit For
                        End If
                     Next J
                  Case Else
                     s1 = 22
                     T1 = 22
                     For J = s1 To T1
                        If CStr(arr1(i, 1)) = Right(arr2(J, 1), 4) Then
                              ARR3(J, 1) = ARR3(J, 1) + IIf(arr1(i, 3) = "", 0, arr1(i, 3))
                              Exit For
                        End If
                     Next J
                  End Select
            End Select
         End If
      Next i
      For J = 1 To 22
         ARR3(J, 1) = Round(ARR3(J, 1), 2)
      Next J
      .Range("U8").Resize(UBound(ARR3), 1) = ARR3
End With
End Sub
绿色我该的别的没动结果就不对呀老师帮助

那么的帅 · 发表于 2011-8-12 21:31

回复 excel白兔的帖子

新增的数据，字符有大小写，原来的数据只有大写

复件 7月原料及主要材料准-8.rar (308.71 KB, 下载次数: 3)

excel白兔 · 发表于 2011-8-12 21:37

回复那么的帅的帖子

谢谢老师老师真是高手！！！！！！！！

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