[英]How to cut entire row based on a specific Text
How to cut the entire row for any cell in column M that contains the word “ time “?如何剪切 M 列中包含“时间”一词的任何单元格的整行?
Noting that I want to keep the data in the same worksheet.注意我想将数据保存在同一个工作表中。 However, cut to the very top.但是,切到最顶端。
January is the name of the sheet in the workbook.一月是工作簿中工作表的名称。
Dim AW As long, I as long
With Sheets("January")
AW = .Range("M2:M" & Rows.Count).End(xlUp).Row
For I = 1 to AW
With .Range("M2:M" & I)
If.Value = " Time" Then
.EntireRow.Cut Sheets("January").Cells(Rows.Count, "A") End(xlUP).offset(1,0)
Sub TestRun()
Call RemoveString("January", "Time", "M")
End Sub
Sub RemoveString(sheetName As String, txt As String, columnLetter As String)
Dim intLastRowNum As Long, intCellNum As Long
With Sheets(sheetName)
intLastRowNum = .UsedRange.Rows.Count
For intCellNum = 3 To intLastRowNum
If LCase(.Range(columnLetter & intCellNum).Value) = LCase(txt) Then
.Rows(intCellNum).EntireRow.Delete
intCellNum = intCellNum - 1
End If
Next
End With
End Sub
A1
.假设数据位于从A1
开始的表中(一行标题和下面的数据)。Option Explicit
Sub cutPasteToTop()
Const wsName As String = "January"
Const cCol As String = "M"
Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
Dim ws As Worksheet: Set ws = wb.Worksheets(wsName)
If ws.AutoFilterMode Then
ws.AutoFilterMode = False
End If
Application.ScreenUpdating = False
Dim irg As Range: Set irg = ws.Range("A1").CurrentRegion
Dim rowsMoved As Boolean
With irg
.AutoFilter ws.Columns(cCol).Column, "Time"
Dim rCount As Long
rCount = WorksheetFunction.Subtotal(103, .Cells.Resize(, 1))
If rCount > 1 Then
Dim srg As Range
Set srg = irg.Resize(irg.Rows.Count - 1).Offset(1) _
.SpecialCells(xlCellTypeVisible)
ws.AutoFilterMode = False
irg.Rows(2).Resize(rCount - 1).Insert
srg.Copy irg.Rows(2).Resize(rCount - 1)
srg.Delete
rowsMoved = True
End If
End With
Application.ScreenUpdating = True
If rowsMoved Then
MsgBox "Rows moved.", vbInformation, "Success"
Else
MsgBox "Nothing moved.", vbExclamation, "Fail?"
End If
End Sub
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.