我正在嘗試在 Excel 上制作 VBA 驗證表以查找所有與預定義模式不匹配的單元格并將其復制到另一個作業表
我的模式是“4個數字/5個數字”例如：1234/12345被接受 2062/67943被接受 372/13333不被接受 1234/1234不被接受等等...
我試圖在條件表中加入以下內容：<>****/***** 和 <>????/????? 并且兩者都不起作用（我不確定該方法的正確性，因為我仍然是 VBA 的初學者）
對于代碼本身，這是我寫的：
Sub GuaranteeElig()
Sheets.Add After:=ActiveSheet
ActiveSheet.Name = SheetName
Sheets("MainSheet").UsedRange.AdvancedFilter Action:= _
xlFilterCopy,
CriteriaRange:=Sheets("ConditionsSheet").Range("B1:B2"), _
CopyToRange:=Range("A1"), Unique:=False
End Sub
關于如何做到這一點的任何提示？
提前致謝 ：）
uj5u.com熱心網友回復：
只要數字的值是獨立的并且無關緊要，并且只有Length數字字串的值才是重要的，您就可以在“搜索”表中的單元格上使用 for 回圈（我假設這是MainSheet如圖所示在您的代碼中？） 其中包含您的值。
從那里，我將提供幾種方法來將資料放置在驗證表中（假設這是您ConditionsSheet的代碼中顯示的資料？）您試圖查明值的位置。
（您可能需要更改部分方法，具體取決于您希望如何在輔助作業表上布置不正確的值集 - 但這應該可以幫助您入門。）當您說您是 VBA 新手時，我添加了大量評論- 這些將幫助您了解正在執行的操作。
Sub GuaranteeElig()
'Adding this to help with performance:
Application.ScreenUpdating = False
'Assuming you are adding a sheet here to work with your found criteria.
Sheets.Add After:=ActiveSheet
ActiveSheet.Name = "ConditionsSheet"
'Using the naming bits below I am assuming the data you are searching for is on MainSheet
'Get used range (most accurate and efficient way I have found yet, others on S.O.
'may have better ways for this - research it if this does not work for you)
'I have had problems using the Sheets().UsedRange method.
Dim c as Long 'This may not be necessary for you if you are looping through only column "A"
Dim r as Long
'Cells(y,x) method uses numerical values for each row (y) or column (x).
c = Cells(1, Columns.Count).End(xlToLeft).Column 'May not be necessary depending on your needs.
'Using this because you have "UsedRange" in your
'code.
'.End(xlToLeft) signifies we are going to the end of the available cell range of
'Row 1 and then performing a "Ctrl Left Arrow" to skip all blank cells until we hit
'the first non-blank cell.
r = Cells(Rows.Count, 1).End(xlUp).Row
'.End(xlUp) method is similar - we go to the end of the available cell range for the
'column ("A" in this case), then performing a "Ctrl Up Arrow" to skip all blank cells.
'If you have a header row which spans across the sheet, this is your best option,
'unless you have 'helper' cells which extend beyond the final column of this header
'row. I am assuming Row 1 is a header in this case - change to your needs.
'For your Rows - choose the column which contains congruent data to the bottom of
'your used range - I will assume column 1 in this case - change to suit your needs.
Dim i as long
Dim j as integer
Dim cel as Range
Dim working_Str() as String 'String Array to use later
Dim string1 as String
Dim string2 as String
Dim badString as Boolean
For i = 2 to r Step 1 'Step down from row 2 to the end of data 1 Row at a time
'Row 1 is header.
set cel=Cells(i, 1) 'Sets the cell to check - assuming data is in Column "A"
'i will change from for loop so 'cel' changes from "A2555"
'to "A2554" to "A2553" etc.
working_Str=Split(cel.Value, "/", -1) 'Splits the value based on "/" inside of cel
string1=working_Str(0) 'what we hope will always be 4 digits
string2=working_Str(1) 'what we hope will always be 5 digits
If Len(string1)<>4 Then 'string1 _(xxxx)_(/)(don't care) does not equal 4 digits in length
badString = True
Elseif Len(string2)<>5 Then ''string1 (don't care)(/)_(xxxxx)_ does not equal 5 digits in length
badString = True
End If
If badString Then 'If either strings above were not correct length, then
'We will copy cell value over to the new sheet "ConditionsSheet"
'Comment the next 2 commands to change from going to one row at a time to
'Matching same row/Cell on the 2nd sheet. Change to suit your needs.
j = j 1 'Counter to move through the cells as you go, only moving one cell
'at a time as you find incorrect values.
Sheets("ConditionsSheet").Range("A" & j).Value=cel.Value 'sets the value on other sheet
'UNComment the next command to change from going to one row at a time to
'matching same row/cell on the 2nd sheet. Change to suit your needs.
'Sheets("ConditionsSheet").Range("A" & i).Value=cel.Value
End if
badString = False 'resets your boolean so it will not fail next check if strings are correct
Next i
'Returning ScreenUpdating back to True to prevent Excel from suppressing screen updates
Application.ScreenUpdating = True
End Sub
更新
檢查我剛剛添加到子程式中的開始和結束行。 Application.ScreenUpdating將抑制或顯示發生的變化 - 抑制它們會使它變得更快。您也不想禁用此設定，因為它會阻止 Excel 在您嘗試在單元格中作業時顯示更新（如編輯單元格值、滾動等...苦苦學習...）
此外，如果給定行中有很多記錄，您可以嘗試先將資料放入陣列中。在這篇 StackOverflow 文章中有一個很好的例子。
跨多行訪問范圍的值會占用大量帶寬，因此首先將范圍移植到陣列中會使速度更快，但仍可能需要一點時間。此外，您訪問陣列資訊的方式會有所不同，但隨著您對其進行更多研究，這將是有意義的。
VBA 的替代品
如果您想嘗試使用公式，您可以使用它 - 只需修改您要搜索的范圍。這可能需要更長的時間，具體取決于處理速度。我正在“Sheet2”上輸入公式并訪問“Sheet1”
=IF(COUNTIF(Sheet1!A1,"????/?????"),1,0)
You are spot on with the search pattern you want to use, you just need to use a function which uses wildcard characters within an "if" function. What you do with the "If value is true" vs "If value is false" bits are up to you. COUNTIF will parse wildcards, so if it is able to "count" the cell matching this string combination, it will result in a "True" value for your if statement.
uj5u.com熱心網友回復：
正則運算式方法，這將在名為 的作業表中轉儲不匹配的值Result，相應地更改輸入范圍和作業表名稱。
在我的測驗中，72k 單元格UsedRange大約需要 4 秒~：
Option Explicit
Sub GuaranteeElig()
Const outputSheetName As String = "Result"
Dim testValues As Variant
testValues = ThisWorkbook.Worksheets("MainSheet").UsedRange.Value 'Input Range, change accordingly
Const numPattern As String = "[\d]{4}\/[\d]{5}"
Dim regex As Object
Set regex = CreateObject("VBScript.Regexp")
regex.Pattern = numPattern
Dim i As Long
Dim n As Long
Dim failValues As Collection
Set failValues = New Collection
'Loop through all the values and test if it fits the regex pattern - 4 digits / 5 digits
'Add the value to failValues collection if it fails the test.
For i = LBound(testValues, 1) To UBound(testValues, 1)
For n = LBound(testValues, 2) To UBound(testValues, 2)
If Not regex.Test(testValues(i, n)) Then failValues.Add testValues(i, n)
Next n
Next i
Erase testValues
Set regex = Nothing
If failValues.Count <> 0 Then
'If there are mismatched value(s) found
'Tranfer the values to an array for easy output later
Dim outputArr() As String
ReDim outputArr(1 To failValues.Count, 1 To 1) As String
For i = 1 To failValues.Count
outputArr(i, 1) = failValues(i)
Next i
'Test if output worksheet exist
Dim outputWS As Worksheet
On Error Resume Next
Set outputWS = ThisWorkbook.Worksheets(outputSheetName)
On Error GoTo 0
'If output worksheet doesn't exist, create a new sheet else clear the first column for array dump
If outputWS Is Nothing Then
Set outputWS = ThisWorkbook.Worksheets.Add
outputWS.Name = outputSheetName
Else
outputWS.Columns(1).Clear
End If
'Dump the array starting from cell A1
outputWS.Cells(1, 1).Resize(UBound(outputArr, 1)).Value = outputArr
Else
MsgBox "No mismatched value found in range"
End If
Set failValues = Nothing
End Sub
如果您不需要不匹配（即唯一值）串列中的重復值，則在注釋中發出聲音。
轉載請註明出處，本文鏈接：https://www.uj5u.com/net/345282.html
下一篇：將excel公式轉換為VBA宏