检核多个门店的调拨表是否正确

LLLWM

一个工作簿中有多个工作表，每个工作表中体现门店的调入调出，怎么做一个检核表检核多个门店的调拨表是否正确？
A门店写了调拨3箱产品给B，B门店填写的数据是否和A店一致

quqiyuan

晚上尝试了一下写个长一点的代码，测试成功的，仅供参考，看看是否合适咯。。。
更新了下，请参考 test1

LLLWM

quqiyuan 发表于 2024-7-3 20:52
晚上尝试了一下写个长一点的代码，测试成功的，仅供参考，看看是否合适咯。。。
更新了下，请参考 test1
...

很可以！但是有点小问题，他的表头会重复

quqiyuan

LLLWM 发表于 2024-7-4 10:22
很可以！但是有点小问题，他的表头会重复

你的数据放到第5行及往下，表头不能在这，代码里已经写了，否则要改代码

quqiyuan

额，改了，就是没有考虑到如果没有的情况，造成把标题作为数组了，加了条件，OK了。供参考。。。
小花走起。。。

quqiyuan

代码如下。。。

Sub test1()
    Dim sh As Worksheet, sht As Worksheet
    Set d = CreateObject("scripting.dictionary")
    Set sh1 = ThisWorkbook.Sheets("核对")
    sh1.UsedRange.Offset(1).ClearContents
    For Each sh In ThisWorkbook.Worksheets
        If sh.Name <> "检核表" And sh.Name <> "核对" Then
            d.RemoveAll
            r = sh.Cells(Rows.Count, 1).End(3).Row
            If r > 4 Then
                arr = sh.Range("a5:g" & r)
                For i = 1 To UBound(arr)
                    For j = 1 To 7
                        s = s & arr(i, j)
                    Next
                    If s <> "" Then d(s) = i
                    s = Empty
                Next
                For Each sht In ThisWorkbook.Worksheets
                    If sh.Name <> "检核表" And sh.Name <> "核对" Then
                        If sht.Name <> sh.Name Then
                            r = sht.Cells(Rows.Count, 8).End(3).Row
                            brr = sht.Range("h5:n" & r)
                            For i = 1 To UBound(brr)
                                s = brr(i, 3) & brr(i, 2) & brr(i, 1)
                                For j = 4 To 7
                                    s = s & brr(i, j)
                                Next
                                If d.exists(s) Then d.Remove s
                                s = Empty
                            Next
                        End If
                    End If
                Next
                If d.Count > 0 Then
                                                    'MsgBox sh.Name & "调出没有问题！"
                                                    'Else: MsgBox sh.Name & "调出有问题！" & "有：" & d.Count & "个问题！"
                    For Each Item In d.items
                        r = sh1.Cells(Rows.Count, 1).End(3).Row + 1
                        For i = 1 To 7
                            sh1.Cells(r, i) = arr(Item, i)
                        Next
                    Next
                End If
            End If
        End If
    Next
    For Each sh In ThisWorkbook.Worksheets
        If sh.Name <> "检核表" And sh.Name <> "核对" Then
            d.RemoveAll
            r = sh.Cells(Rows.Count, 8).End(3).Row
            If r > 4 Then
                arr = sh.Range("h5:n" & r)
                For i = 1 To UBound(arr)
                    s = arr(i, 3) & arr(i, 2) & arr(i, 1)
                    For j = 4 To 7
                        s = s & arr(i, j)
                    Next
                    If s <> "" Then d(s) = i
                    s = Empty
                Next
                For Each sht In ThisWorkbook.Worksheets
                    If sh.Name <> "检核表" And sh.Name <> "核对" Then
                        If sht.Name <> sh.Name Then
                            r = sht.Cells(Rows.Count, 1).End(3).Row
                            brr = sht.Range("a5:g" & r)
                            For i = 1 To UBound(brr)
                                For j = 1 To 7
                                    s = s & brr(i, j)
                                Next
                                If d.exists(s) Then d.Remove s
                                s = Empty
                            Next
                        End If
                    End If
                Next
                If d.Count > 0 Then
                                                        'MsgBox sh.Name & "调入没有问题！"
                                                        'Else: MsgBox sh.Name & "调入有问题！" & "有：" & d.Count & "个问题！"
                    For Each Item In d.items
                        r = sh1.Cells(Rows.Count, 8).End(3).Row + 1
                        For i = 1 To 7
                            sh1.Cells(r, i + 7) = arr(Item, i)
                        Next
                    Next
                End If
            End If
        End If
    Next
    Set d = Nothing
    Beep
    sh1.Activate
    With sh1.UsedRange.Offset(1)
        .HorizontalAlignment = xlCenter
    End With
End Sub

abc3479

你的表格这样设置好点吧？？

LLLWM

quqiyuan 发表于 2024-7-4 11:49
代码如下。。。

Sub test1()

你好，本月门店实际操作之后我放了几个门店进去，检核的时候会提示“运行时错误'13: 类型不匹配”是为什么呢？

quqiyuan

LLLWM 发表于 2024-8-5 16:27
你好，本月门店实际操作之后我放了几个门店进去，检核的时候会提示“运行时错误'13: 类型不匹配”是为什 ...

内容错误会造成代码中的字符串不同类型错误

LLLWM

quqiyuan 发表于 2024-8-5 16:54
内容错误会造成代码中的字符串不同类型错误

如果这个调拨表不考虑调拨日期一致应该怎么设置呢？因为A门店有可能8/3调出去，B门店8/5才收到