如何实现每周数据提取到汇总表，求大神

neil.he

大神，每周备用金要进行登记，分为第1周、第2周...很多个sheet，然后每个表格有数据的行有可能多有可能少不是一样的，格式是一样的，如何实现有数据的部分提取汇总到汇总表里？

shiruiqiang

新手，猜不出，路过

ykcbf1100

只是空表，没有数据，不好调试，那只能先这样了。

3190496160

Sub 汇总()
Application.ScreenUpdating = False
Dim ar As Variant
Dim sht As Worksheet
Set sht = Sheets("汇总表")
sht.UsedRange.Offset(8) = Empty
For Each sh In Sheets
    If sh.Name <> "汇总表" Then
        r = sh.Cells(Rows.Count, 2).End(xlUp).Row
        If r > 8 Then
            ar = sh.Range("b9:j" & r)
            rs = sht.Cells(Rows.Count, 2).End(xlUp).Row + 1
            sht.Cells(rs, 2).Resize(UBound(ar), UBound(ar, 2)) = ar
        End If
    End If
Next sh
Application.ScreenUpdating = True
MsgBox "汇总完毕"
End Sub

3190496160

备用金周报模板.rar (200.18 KB, 下载次数: 10)

2022-12-30 12:09 上传

点击文件名下载附件

10101100

1. Sub 汇总()
   
2.     Dim sht As Worksheet
   
3.     Dim row, count As Integer
   
4.     row = 9
   
5.    
   
6.     For Each sht In Worksheets
   
7.         If sht.Name <> "汇总表" Then
   
8.             If sht.Cells(9, 2).Value <> "" Then
   
9.             count = sht.Cells(8, 2).End(xlDown).row
   
10.                 sht.Cells(9, 2).Resize(count - 8, 9).Copy Sheets("汇总表").Cells(row, 2)
    
11.                 row = row + count - 8
    
12.             End If
    
13.             
    
14.         End If
    
15.     Next
    
16. End Sub

复制代码

neil.he

感谢 满足使用

supermouse24

逻辑：
1.建立排班人的名字和上班人的字典
2.随机生成上班人的名字，数字代替。
3.设置两个如果，满足最少上班天数。
注意：这里有个GOTO，设置排班天数超过7天，会死循环。

Sub 随机排班()
    Set dic_name = CreateObject("scripting.dictionary")
    Set dic_on_work = CreateObject("scripting.dictionary")
   
   
    With Worksheets("sheet1")
        .Rows("4:8").ClearContents
        
        
        arr = .[a3].Resize(1, 15).Value
        For i = 1 To UBound(arr, 2)
            dic_name(i) = 0
        Next
        
        Randomize
        max_num = UBound(arr, 2) + 1
        min_num = 1
        
        For days_ = 1 To 5 '排班日子
            For people = 1 To 5 '一天安排多少人上班
重做:
                on_work = Int((max_num - min_num) * Rnd + min_num)
                If Not dic_on_work.Exists(on_work) And dic_name(on_work) < 1 Then
                    dic_name(on_work) = dic_name(on_work) + 1
                    .Cells(days_ + 3, on_work) = "√"
                    dic_on_work(on_work) = 0
                ElseIf Not dic_on_work.Exists(on_work) And dic_name(on_work) < 2 Then
                    dic_name(on_work) = dic_name(on_work) + 1
                    .Cells(days_ + 3, on_work) = "√"
                    dic_on_work(on_work) = 0
                Else
                    GoTo 重做 '排班日子的不要设置太大，不然会死循环。
                End If
            Next
            dic_on_work.RemoveAll
        Next
    End With


End Sub