条件,需要做拆分转成笔数带入

cmo9020 · 发表于 2023-1-20 15:04

本帖最后由 cmo9020 于 2023-1-22 10:55 编辑

TEST.rar (28.79 KB, 下载次数: 8)

年假愉快~在这请导师们帮增加条件功能一下.....
原本的数据功能
依据B1单元格选项,与sheet1 E列比对相同
在和B3:B15单元格比对,与sheet1 F列比对相同
把Sheet1 F列比对相同转成笔数带入C4:J15

现在需要多出条件
不知道怎么修改，sheet1 H列有 ","点,需要做拆分.....
是要另外成立一个新代码做CALL 动作
还是在里面直接修改就可以呢?

祝大家事事顺心、吉祥如意

3190496160 · 发表于 2023-1-20 16:21

Sub 包装汇总()
Application.ScreenUpdating = False
Dim ar As Variant, br As Variant
Dim d As Object
Set d = CreateObject("scripting.dictionary")
With Sheets("sheet1")
r = .Cells(Rows.count, 5).End(xlUp).Row
ar = .Range("a1:h" & r)
End With
With Sheets("包装汇总")
.[a1].CurrentRegion.Offset(1) = Empty
y = .Cells(1, Columns.count).End(xlToLeft).Column
h = UBound(ar) + 1
br = .Range(.Cells(1, 1), .Cells(h, y))
For j = 2 To UBound(br, 2)
      If Trim(br(1, j)) <> "" Then
         d(Trim(br(1, j))) = j
      End If
Next j
k = 1
For i = 2 To UBound(ar)
      If Trim(ar(i, 5)) = "包装" Then
         If Trim(ar(i, 8)) <> "" Then
            If InStr(ar(i, 8), ",") = 0 Then
                  zd = Trim(ar(i, 8))
                  t = d(zd)
                  If t = "" Then
                     k = k + 1
                     d(zd) = k
                     t = k
                     br(k, 1) = zd
                  End If
                  lh = d(Trim(ar(i, 4)))
                  If lh <> "" Then
                     br(t, lh) = br(t, lh) + 1
                  End If
            Else
                  rr = Split(ar(i, 8), ",")
                  For s = 0 To UBound(rr)
                     If Trim(rr(s)) <> "" Then
                        zd = rr(s)
                        t = d(zd)
                        If t = "" Then
                              k = k + 1
                              d(zd) = k
                              t = k
                              br(k, 1) = zd
                        End If
                        lh = d(Trim(ar(i, 4)))
                        If lh <> "" Then
                              br(t, lh) = br(t, lh) + 1
                        End If
                     End If
                  Next s
            End If
         End If
      End If
Next i
If k = 1 Then MsgBox "没有需要汇总的数据": End
.[a1].Resize(k, UBound(br, 2)) = br
.[a1].Resize(k, UBound(br, 2)).Borders.LineStyle = 1
End With
Application.ScreenUpdating = True
MsgBox "ok!"
End Sub

3190496160 · 发表于 2023-1-20 16:22

TEST.rar (26.9 KB, 下载次数: 8)

山菊花 · 发表于 2023-1-20 16:56

供参考。

cmo9020 · 发表于 2023-1-21 15:14

谢谢导师们指点,你们方式都各有所长
祝你们新年新气象，今年发大财

cmo9020 · 发表于 2023-1-21 15:15

山菊花发表于 2023-1-20 16:56
供参考。

寻问一下山菊花导师
sheet1 F列出货也有出现产品异常
现在B1点选出货，也会跟着出现产品异常项次

有办法除了点选包装显示产品异常
其他选项的产品异常不显示

要怎么去定义,除了包装的产品异常,其他的产品异常都不显示?
在谢谢您的指导~

cmo9020_条件,需要做拆分转成笔数带入.rar (34.54 KB, 下载次数: 4)

山菊花 · 发表于 2023-1-21 20:16

cmo9020 发表于 2023-1-21 15:15
寻问一下山菊花导师
sheet1 F列出货也有出现产品异常
现在B1点选出货，也会跟着出现产品异常项次

增加一个条件：
If Arr(i, 2) = "包装" And Arr(i, 3) = "产品异常" Then

cmo9020 · 发表于 2023-1-21 21:52

3190496160 发表于 2023-1-20 16:22

春风导师,请教一下...
有没有办法把范围设成从第20开始.....
对于范围控制我逻辑有点错乱,不太会修改您的代码.........
在麻烦您一下,谢谢您,新年吉祥快乐

TEST.rar (28.24 KB, 下载次数: 5)

3190496160 · 发表于 2023-1-22 09:04

TEST.rar (26.33 KB, 下载次数: 7)

cmo9020 · 发表于 2023-1-22 10:54

3190496160 发表于 2023-1-22 09:04

春风导师您好,谢谢您的关注~~~
事情己圆满,新年快乐~恭禧发财

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

[已解决] 条件,需要做拆分转成笔数带入

评分

评分

评分

评分

评分