|
#2
lianyicq2015-07-17 14:51
回复 楼主 zhl810103
下面代码实现了在打开的工作簿所有工作表中查找指定的字符串，并将其所在表名及地址添加到list控件中。窗体中添加list和command控件各一。
查找指定日期还有问题，不能找到同一工作表内的所有指定日期。自己也想想办法，多试试。  程序代码：Option Explicit 用findnext没能查找到所有指定时间，还不清楚是什么原因造成，没查到相关资料。Dim EXAPP As Excel.Application Dim WB As Excel.Workbook Dim sht As Excel.Worksheet Private Sub Command1_Click() Dim dest As String Dim i As Integer Dim p As Excel.Range Dim firstaddress Set EXAPP = CreateObject("excel.application") Set WB = EXAPP.Workbooks.Open("c:\test1.xlsx") Set sht = WB.Worksheets("Sheet1") dest = "要查找的字符串" Set sht = Nothing For i = 1 To WB.Worksheets.Count Set sht = WB.Worksheets(i) Set p = sht.Cells.Find(dest) If Not p Is Nothing Then List1.AddItem (sht.Name & " " & p.Address) firstaddress = p.Address Do Set p = sht.Cells.FindNext(p) If Not p Is Nothing Then If p.Address = firstaddress Then Exit Do List1.AddItem (sht.Name & " " & p.Address) Else Exit Do End If Loop End If Set p = Nothing Next WB.Close Set sht = Nothing Set WB = Nothing Set EXAPP = Nothing End Sub 改为全部用find查找后，结果正常。修改后代码如下 程序代码：Option Explicit Dim EXAPP As Excel.Application Dim WB As Excel.Workbook Dim sht As Excel.Worksheet Private Sub Command1_Click() Dim dest As String Dim i As Integer Dim p As Excel.Range Dim firstaddress Set EXAPP = CreateObject("excel.application") Set WB = EXAPP.Workbooks.Open("c:\test1.xlsx") Set sht = WB.Worksheets("Sheet1") dest = sht.Cells(4, 2) '查找日期所在的单元格 For i = 1 To WB.Worksheets.Count Set sht = WB.Worksheets(i) Set p = sht.Cells.Find(dest) firstaddress = p.Address If Not p Is Nothing Then List1.AddItem (sht.Name & " " & p.Address & " " & p) Do Set p = sht.Cells.Find(dest, p) If Not p Is Nothing Then If p.Address = firstaddress Then Exit Do List1.AddItem (sht.Name & " " & p.Address & " " & p) Else Exit Do End If Loop End If Next Set p = Nothing WB.Close Set sht = Nothing Set WB = Nothing Set EXAPP = Nothing End Sub [ 本帖最后由 lianyicq 于 2015-7-17 15:57 编辑 ] |
通过DSF工作簿中YSJ工作表C2单元格的日期，在其他工作表中查询相同的日期并定位在其向下一单元格，帮看一下代码，新手谢谢。
Set xlbook = xlapp.Workbooks.Open(App.Path& "\dsf.xls", , , , "2011")
Set xlsheet = xlbook.Worksheets("YSJ")
Dim rng As Range, st, sh As Workbook, x
For x = 1 To 48
If Cells.Item(2, 3).Value <> "" Then
st = Cells.Item(2, 3).Value
For Eachsh In Sheets
If sh.Name<> "YSJ" Then
Set rng = sh.Cells.Find(st)
If Not rng Is Nothing Then
Application.Gotorng.Offset(x)
Exit For
End If
End If
Next
ActiveCell.FormulaR1C1 = "=SUMIFS(YSJ!C[-7],YSJ!C[-10],RC[-9],YSJ!C[-9],""汇总"")"
rng.Offset(x).Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Else
MsgBox "无记录": Exit Sub
End If
Next x