我對visual basic完全陌生。我有一些包含數字的電子表格。我想洗掉包含特定范圍之外的數字的任何行。在visual basic中是否有一種直接的方法來做到這一點？
例如，在第一個電子表格（影像鏈接）中，我想洗掉包含數字超出以下兩個范圍的單元格的行：60101-60501 和 74132-74532。
誰能給我一些指點？謝謝！
uj5u.com熱心網友回復：
代碼
您需要根據自己的需要呼叫它，如例程“Exec_DeleteRows”所示。我假設您需要它是否等于或小于您在例行程式中宣告的那個。在此示例中，我將洗掉值介于 501-570 之間的行，然后洗掉值介于 100-200 之間的行
Sub Exec_DeleteRows()
Call Exec_DeleteRowsInRangeBasedOnNumberValue(Range("C8:H11"), 501, 570)
Call Exec_DeleteRowsInRangeBasedOnNumberValue(Range("C8:H11"), 100, 200)
End Sub
Sub Exec_DeleteRowsInRangeBasedOnNumberValue(RangeToWorkIn As Range, NumPivotToDeleteRowBottom As Double, NumPivotToDeleteRowTop As Double)
Dim RangeRowsToDelete As Range
Dim ItemRange As Range
For Each ItemRange In RangeToWorkIn
If IsNumeric(ItemRange.Value) = False Then GoTo SkipStep1
If ItemRange.Value >= NumPivotToDeleteRowBottom And ItemRange.Value <= NumPivotToDeleteRowTop Then ' 1. If ItemRange.Value >= NumPivotToDeleteRowBottom And ItemRange.Value <= NumPivotToDeleteRowTop
If RangeRowsToDelete Is Nothing Then ' 2. If RangeRowsToDelete Is Nothing
Set RangeRowsToDelete = RangeToWorkIn.Parent.Rows(ItemRange.Row)
Else ' 2. If RangeRowsToDelete Is Nothing
Set RangeRowsToDelete = Union(RangeToWorkIn.Parent.Rows(ItemRange.Row), RangeRowsToDelete)
End If ' 2. If RangeRowsToDelete Is Nothing
End If ' 1. If ItemRange.Value >= NumPivotToDeleteRowBottom And ItemRange.Value <= NumPivotToDeleteRowTop
SkipStep1:
Next ItemRange
If Not (RangeRowsToDelete Is Nothing) Then RangeRowsToDelete.EntireRow.Delete
End Sub
演示
uj5u.com熱心網友回復：
洗掉包含錯誤數字的行
- 假設資料從包含此代碼 ( )的作業簿中
A1的作業表開始，并具有一行標題 ( )。Sheet1ThisWorkbook2 - 這只是熟悉變數、資料型別、物件、回圈和
If陳述句的基本示例。它可以在多個帳戶上改進。
Option Explicit
Sub DeleteWrongRows()
Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
Dim ws As Worksheet: Set ws = wb.Worksheets("Sheet1") ' worksheet
Dim rg As Range: Set rg = ws.Range("A1").CurrentRegion ' range
Application.ScreenUpdating = False
Dim rrg As Range ' Row Range
Dim rCell As Range ' Cell in Row Range
Dim rValue As Variant ' Value in Cell
Dim r As Long ' Row
Dim DoDelete As Boolean
' Loop backwards through the rows of the range.
For r = rg.Rows.Count To 2 Step -1
Set rrg = rg.Rows(r)
' Loop through cells in row.
For Each rCell In rrg.Cells
rValue = rCell.Value
If IsNumeric(rValue) Then ' is a number
If rValue >= 60101 And rValue <= 60501 Then ' keep
ElseIf rValue >= 74132 And rValue <= 74532 Then ' keep
Else ' delete (outside the number ranges)
DoDelete = True
End If
Else ' is not a number
DoDelete = True
End If
If DoDelete Then ' found a cell containing a wrong value
rCell.EntireRow.Delete
DoDelete = False
Exit For ' no need to check any more cells
'Else ' found no cell containing a wrong value (do nothing)
End If
Next rCell
Next r
Application.ScreenUpdating = True
MsgBox "Rows with wrong numbers deleted.", vbInformation
End Sub
uj5u.com熱心網友回復：
使用Range.Delete是在 Excel VBA 中完全擦除一行的內置方法。要檢查整行的數字是否符合特定條件，您需要一個Loop和一個If Statement。
要以更快的速度評估大量值，首先將 Excel 作業表中的相關資料提取到陣列中是明智之舉。進入陣列后，很容易將回圈設定為從陣列的每一行和列的第一個元素 ( LBound ) 運行到最后一個元素 ( UBound )。
此外，當從作業表中洗掉大量范圍時，在您仍在回圈的同時首先收集 ( Union ) 范圍，然后在最后將洗掉作為單個步驟進行，這樣會更快且不那么混亂。這樣，范圍地址在回圈期間不會更改，您無需重新調整以跟蹤它們的新位置。這樣我們可以節省大量時間，因為應用程式想要在每次洗掉后暫停并重新計算作業表。
所有這些想法放在一起：
Sub Example()
DeleteRowsOutside ThisWorkbook.Worksheets("Sheet1"), Array(60101, 60501), Array(74132, 74532)
End Sub
Sub DeleteRowsOutside(OnSheet As Worksheet, ParamArray Min_and_Max() As Variant)
If OnSheet Is Nothing Then Set OnSheet = ActiveSheet
'Find the Bottom Corner of the sheet
Dim BottomCorner As Range
Set BottomCorner = OnSheet.Cells.Find("*", After:=OnSheet.Range("A1"), SearchDirection:=xlPrevious)
If BottomCorner Is Nothing Then Exit Sub
'Grab all values into an array
Dim ValArr() As Variant
ValArr = OnSheet.Range(OnSheet.Cells(1, 1), BottomCorner).Value
'Check each row value against min & max
Dim i As Long, j As Long, DeleteRows As Range
For i = LBound(ValArr, 1) To UBound(ValArr, 1) 'For each Row
For j = LBound(ValArr, 2) To UBound(ValArr, 2) 'For each column
Dim v As Variant: v = ValArr(i, j)
If IsNumeric(v) Then
Dim BoundaryPair As Variant, Is_Within_A_Boundary As Boolean
Is_Within_A_Boundary = False 'default value
For Each BoundaryPair In Min_and_Max
If v >= BoundaryPair(0) And v <= BoundaryPair(1) Then
Is_Within_A_Boundary = True
Exit For
End If
Next BoundaryPair
If Not Is_Within_A_Boundary Then
'v is not within any acceptable ranges! Mark row for deletion
If DeleteRows Is Nothing Then
Set DeleteRows = OnSheet.Rows(i)
Else
Set DeleteRows = Union(DeleteRows, OnSheet.Rows(i))
End If
GoTo NextRow 'skip to next row
End If
End If
Next j
NextRow:
Next i
If Not DeleteRows Is Nothing Then DeleteRows.EntireRow.Delete
End Sub Exit For 'skip to next row
End If
End If
Next j
Next i
If Not DeleteRows Is Nothing Then DeleteRows.EntireRow.Delete
End Sub
我使用ParamArray來接受可變數量的 Min 和 Max 范圍。為了保持整潔，Min 和 Max 對都在各自的陣列中。只要該行中的所有數字都在任何提供的范圍內，該行就不會被洗掉。
uj5u.com熱心網友回復：
這是我一直在研究的一些帶有正則運算式和腳本字典的代碼。我這樣做是為了我的目的，但它可能在這里和其他人有用。
我找到了一種基于陣列選擇非連續單元格然后洗掉這些單元格的方法。
在這種情況下，我選擇了行號，因為 VBA 阻止了由于重疊范圍而洗掉行。
Sub findvalues()
Dim Reg_Exp, regexMatches, dict As Object
Dim anArr As Variant
Dim r As Range, rC As Range
Set r = Sheets(3).UsedRange
Set r = r.Offset(1).Resize(r.Rows.Count - 1, r.Columns.Count)
Set Reg_Exp = CreateObject("vbscript.regexp")
With Reg_Exp
.Pattern = "^[6-6]?[0-0]?[1-5]?[0-0]?[1-1]?$|^60501$" 'This pattern is for the 60101 to 60501 range.
End With
Set dict = CreateObject("Scripting.Dictionary")
For Each rC In r
If rC.Value = "" Then GoTo NextRC ''skip blanks
Set regexMatches = Reg_Exp.Execute(rC.Value)
If regexMatches.Count = 0 Then
On Error Resume Next
dict.Add rC.Row & ":" & rC.Row, 1
End If
NextRC:
Next rC
On Error GoTo 0
anArr = Join(dict.Keys, ", ")
Sheets(3).Range(anArr).Delete Shift:=xlShiftUp
End Sub
轉載請註明出處，本文鏈接：https://www.uj5u.com/caozuo/366309.html
下一篇：轉置細胞內容