上次的大家没看懂，这次我加了附件

temyoung

主要是把1.xls跟2.xls的数据复制到情况统计表中，其中③的累计完成那一列还要加上品种2、品种3 的①，不知道我表述清楚没，下面是我自己写的，但是有bug跑不完




Sub ss()
  Dim i, j, k As Integer
   
   
    '打开数据表
    Dim str As String
    Dim wb As Workbook
    str = Dir("E:\桌面\刷数据\ss\*.*")
    Set wb = Workbooks.Open("E:\桌面\刷数据\ss\" & str)

    '当日接种数据
    Workbooks.Open Filename:="E:\桌面\刷数据\当日数据\1.xls"
    Windows("1.xls").Activate
    Set wb1 = Workbooks.Open("E:\桌面\刷数据\当日数据\1.xls")


    If wb1.Sheets(1).Range("c3") = "①" Then
    wb1.Sheets(1).Range("C4:C23").Select
    Selection.Copy
    Windows(str).Activate
    Range("D3").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlPasteSpecialOperationNone, SkipBlanks:=False, Transpose:=False
    Windows("1.xls").Activate
    Else
    wb.Sheets(1).Range("d3:d22") = 0
    End If

    If wb1.Sheets(1).Range("d3") = "②" Then
    wb1.Sheets(1).Range("D4:D23").Select
    Selection.Copy
    Windows(str).Activate
    Range("H3").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlPasteSpecialOperationNone, SkipBlanks:=False, Transpose:=False
    Windows("1.xls").Activate
    Else
    wb.Sheets(1).Range("h3:h22") = 0
    End If
   
   
    If wb1.Sheets(1).Range("e3") = "③" Then
    wb1.Sheets(1).Range("E4:E23").Select
    Selection.Copy
    Windows(str).Activate
    Range("L3").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlPasteSpecialOperationNone, SkipBlanks:=False, Transpose:=False
    Windows("1.xls").Activate
    Else
    wb.Sheets(1).Range("l3:l22") = 0
    End If
   
   
  
   
   '累计数据
    Workbooks.Open Filename:="E:\桌面\刷数据\当日数据\2.xls"
    Windows("2.xls").Activate
    Set wb2 = Workbooks.Open("E:\桌面\刷数据\当日数据\2.xls")




    If wb2.Sheets(1).Range("c3") = "①" Then
    wb2.Sheets(1).Range("C4:C23").Select
    Selection.Copy
    Windows(str).Activate
    Range("E3").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlPasteSpecialOperationNone, SkipBlanks:=False, Transpose:=False
    Windows("2.xls").Activate
    Else
    wb2.Sheets(1).Range("e3:e22") = 0
    End If
   
    If wb2.Sheets(1).Range("d3") = "②" Then
    wb2.Sheets(1).Range("D4:D23").Select
    Selection.Copy
    Windows(str).Activate
    Range("I3").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlPasteSpecialOperationNone, SkipBlanks:=False, Transpose:=False
    Windows("2.xls").Activate
    Else
    wb2.Sheets(1).Range("I3:I22") = 0
    End If
   
   
   
    If wb2.Sheets(1).Range("e3") = "③" Then
    Windows(str).Activate
    For x = 6 To 20
        If wb2.Sheets(1).Cells(3, x) = "①" Then
        For y = 3 To 22
       wb.Sheets(1).Range("m" & y) = wb2.Sheets(1).Range("e" & y + 1) + wb2.Sheets(1).Cells(y + 1, x)
        Next
        End If
        x = x + 1
    Next
    Else
    wb2.Sheets(1).Range("m" & y) = wb.sheess(1).cell(y + 1, x)
    End If
   
   
   
   
   
End Sub

LIUZHU

2.xls是累计数吧，里面品种1、品种2、品种3中都有①，这个是合并到一起算累计数么？

ykcbf1100

还是没看懂啊。
首先，1.xls和2.xls表结构并不相同，第2，汇总表和分表的数据并不对应。第3，根据啥来汇总表的，序号？

wxxydl

你的模拟数据  和模拟结果都要给出   才知道你的意思

LIUZHU

我用A001、A002...这种暂时代表地区吧，不同品种的①②③合并

LIUZHU

楼主的软件是WPS，应该是可以运行了

LIUZHU

附件在此，请测试

temyoung

ykcbf1100 发表于 2023-1-4 10:54
还是没看懂啊。
首先，1.xls和2.xls表结构并不相同，第2，汇总表和分表的数据并不对应。第3，根据啥来汇总 ...

1.xls跟2.xls并不是固定的，表1应该算是最基本的了，还有的话会另加。2.汇总表的地区跟分表的地区是对应的。3汇总就是把表1跟表2汇总到一起，以地区汇总

temyoung

LIUZHU 发表于 2023-1-4 11:31
附件在此，请测试

很厉害啊，大佬，但是代码好像很复杂我没怎么接触过

temyoung

这是模拟数据跟结果