求助运行这个代码如何实现搜索

zpy2

'module 1

Public d

Public findString

Sub button_Click()

    Application.ScreenUpdating = False

    ActiveSheet.UsedRange.ClearContents

   rem Cells(1, 1) = "stringFind"

   findString=cells(1,1)

    Set d = CreateObject("scripting.dictionary")

    Getfd (ThisWorkbook.Path) 'ThisWorkbook.Path是当前代码文件所在路径，路径名可以根据需求修改

    Application.ScreenUpdating = True

    If d.Count > 0 Then

        ThisWorkbook.Sheets(1).[a2].Resize(d.Count) = WorksheetFunction.Transpose(d.keys)

        ThisWorkbook.Sheets(1).[b2].Resize(d.Count) = WorksheetFunction.Transpose(d.items)

    End If

End Sub

Sub Getfd(ByVal pth)



    Set Fso = CreateObject("scripting.filesystemobject")

    Set ff = Fso.getfolder(pth)

    For Each f In ff.Files

        Rem 具体提取哪类文件，还是需要根据文件扩展名进行处理

        If InStr(Split(f.Name, ".")(UBound(Split(f.Name, "."))), "xl") > 0 Then

            If f.Name <> ThisWorkbook.Name Then

                Set wb = Workbooks.Open(f)

                For Each sht In wb.Sheets

                    If WorksheetFunction.CountA(sht.UsedRange) > 1 Then

                        arr = sht.UsedRange

                   rem     For j = 2 To UBound(arr)

                   rem         d(arr(j, 1)) = d(arr(j, 1)) + arr(j, 2)

                  rem      Next j

                                  rem handle each data of a sheet

call handle_find(arr,pth,f)

                    End If

                Next sht

                wb.Close False

            End If

        End If

    Next f

    For Each fd In ff.subfolders

        Getfd (fd)

    Next fd

End Sub

sub handle_find(arr,pth,f)

For r = 1 To UBound(arr)

For j = 1 To UBound(arr, 2)

If arr(r, j) = findString Then

rem need test

d(pth & "\" & f.name)=""

Exit For

End If

end sub

ykcbf1100

这个，让版主来吧，版主精通。

zpy2

ykcbf1100 发表于 2022-11-24 13:49
这个，让版主来吧，版主精通。

就是版主liu的代码，改了一下，想实现多文件搜索。

群里帮忙运行了一下，排除了一些 ~开头的，加了 next

发现 arr = sht.UsedRange,在 子文件夹 文件 1.21.xlsx 只有a1单元格有值，不能返回数组arr(1,1),是空的,其他还没发现。

arr=
'module 1
Public d
Public findString
Sub button_Click()
    Application.ScreenUpdating = False
    ActiveSheet.UsedRange.ClearContents
   rem Cells(1, 1) = "stringFind"
   findString=cells(1,1)
   findString="test"
   rem here fixed value for test
    Set d = CreateObject("scripting.dictionary")
    Getfd (ThisWorkbook.Path) 'ThisWorkbook.Path是当前代码文件所在路径，路径名可以根据需求修改
    Application.ScreenUpdating = True
    If d.Count > 0 Then
        ThisWorkbook.Sheets(1).[a2].Resize(d.Count) = WorksheetFunction.Transpose(d.keys)
        ThisWorkbook.Sheets(1).[b2].Resize(d.Count) = WorksheetFunction.Transpose(d.items)
    End If
End Sub
Sub Getfd(ByVal pth)
   
    Set Fso = CreateObject("scripting.filesystemobject")
    Set ff = Fso.getfolder(pth)
    For Each f In ff.Files
        Rem 具体提取哪类文件，还是需要根据文件扩展名进行处理
        If InStr(Split(f.Name, ".")(UBound(Split(f.Name, "."))), "xl") > 0 and not （left（f.Name,1）="～"） Then
            If f.Name <> ThisWorkbook.Name Then
                Set wb = Workbooks.Open(f)
                For Each sht In wb.Sheets
                    If WorksheetFunction.CountA(sht.UsedRange) > 0 Then
                        arr = sht.UsedRange
                   rem     For j = 2 To UBound(arr)
                   rem         d(arr(j, 1)) = d(arr(j, 1)) + arr(j, 2)
                  rem      Next j
                                  rem handle each data of a sheet
call handle_find(arr,pth,f)
                    End If
                Next sht
                wb.Close False
            End If
        End If
    Next f
    For Each fd In ff.subfolders
        Getfd (fd)
    Next fd
End Sub


sub handle_find(arr,pth,f)
For r = 1 To UBound(arr)
For j = 1 To UBound(arr, 2)
If arr(r, j) = findString Then
rem need test
d(pth & "\" & f.name)=""
Exit For
End If
next
next
end sub

zpy2

create temp table aa as
select *,row_number() over (order by random()) 序 from 员工名单随机分组后进行排班 where rowid<19 order by random();
create temp table bb as
select '班次'||((序-1)/6+1)  班次,'星期'||((序-1)%6+1) 星期,员工名单 from aa;
//select rowid,* from bb where rowid<19;
create temp table cc as
select row_number() over () old_rowid,员工名单 `班次4` from 员工名单随机分组后进行排班 where rowid>=19;
//select * from cc;
cli_create_two_dim~bb~班次~员工名单;

select * from (select row_number() over (order by random()) old_rowid,* from bb_two_dim ) a left join cc on a.old_rowid=cc.old_rowid order by 星期;


这道题不容易，记录一下
https://club.excelhome.net/forum.php?mod=viewthread&tid=1656116&fromguid=hot&extra=&mobile&_dsign=e883fff0