删行

ddz79101

老师！我想删除无用行，使得指定的行成为首行，但指定的行在先后出现的表中略有不同，我想只用1个代码解决此差异，请老师看看。谢谢

titi012

1. Sub wuwuwu()
   
2.     Dim Sh As Worksheet
   
3.     Dim Arr, i&, j&, xBoo As Boolean
   
4.     For Each Sh In ThisWorkbook.Sheets
   
5.         Arr = Sh.UsedRange
   
6.         xBoo = False
   
7.         For i = 1 To UBound(Arr)
   
8.             For j = 1 To UBound(Arr, 2)
   
9.                 If Arr(i, j) Like "交易时间" Or Arr(i, j) Like "序号" Then xBoo = True: Exit For
   
10.             Next j
    
11.             If xBoo Then Sh.Rows("1:" & i - 1).Delete: Exit For
    
12.         Next i
    
13.     Next Sh
    
14. End Sub

复制代码

ykcbf1100

附件供参考。。。

chxw68

1. Sub test()
   
2.     Dim r%, i%
   
3.     Dim ws As Worksheet
   
4.     Dim rng As Range
   
5.     For Each ws In Worksheets
   
6.         If ws.Name <> "目录" Then
   
7.             With ws
   
8.                 Set rng = .UsedRange.Find(what:="交易时间", LookIn:=xlValues, lookat:=xlWhole, searchorder:=xlByRows, searchdirection:=xlNext)
   
9.                 If rng Is Nothing Then
   
10.                     Set rng = .UsedRange.Find(what:="序号", LookIn:=xlValues, lookat:=xlWhole, searchorder:=xlByRows, searchdirection:=xlNext)
    
11.                 End If
    
12.                 If Not rng Is Nothing Then
    
13.                     r = rng.Row - 1
    
14.                     .Rows("1:" & r).Delete
    
15.                 End If
    
16.             End With
    
17.         End If
    
18.     Next
    
19. End Sub
    

复制代码

ykcbf1100

参与一下。。。

1. Sub ykcbf()  '//2024.12.19
   
2.     Application.ScreenUpdating = False
   
3.     Application.DisplayAlerts = False
   
4.     On Error Resume Next
   
5.     For Each sht In Sheets
   
6.         If InStr(sht.Name, "目录") = 0 Then
   
7.             With sht
   
8.                 r1 = .UsedRange.Find("交易时间").Row
   
9.                 If r1 <> Empty Then .Rows("1:" & r1 - 1).Delete
   
10.                 r = .UsedRange.Find("序号").Row
    
11.                 If r <> Empty Then .Rows("1:" & r - 1).Delete
    
12.             End With
    
13.         End If
    
14.     Next
    
15.     Application.ScreenUpdating = True
    
16.     Application.DisplayAlerts = True
    
17.     MsgBox "OK！"
    
18. End Sub
    

复制代码

chxw68

详见附件。

loirol

ddz79101

titi012 发表于 2024-12-19 09:58

谢谢老师！运行成功

ddz79101

ykcbf1100 发表于 2024-12-19 10:14
附件供参考。。。

谢谢老师！运行成功！

ddz79101

chxw68 发表于 2024-12-19 10:16
详见附件。

谢谢老师！运行成功！