You need to enable JavaScript to run this app.
优惠活动
大模型
产品
解决方案
定价
更多

VBA代码精确匹配问题:解决A类代码误匹配AE/AA/AAA的方法

Fix Exact Matching for VBA Row Move Logic

The Problem

Your current code uses Like "*A*" for column C, which matches any cell containing "A" (like AE, AA, AAA) instead of only cells that are exactly "A". We need to adjust the matching condition to target precise values only, plus fix a small typo that would cause a runtime error.

Modified Code

Here's the updated code with exact matching and error fixes:

Dim rw1 As Long, lastrow1 As Long, MySel1 As Range 'Grabs skus and moves to new sheet
With Workbooks("11 Production").Worksheets("Sheet1")
    For rw1 = 1000 To 2 Step -1
        ' Switch from fuzzy match to exact match for column C
        ' Add Trim() if you need to ignore accidental leading/trailing spaces: Trim(.Cells(rw1, 3).Value) = "A"
        If .Cells(rw1, 2).Value Like "*Minor Novice*" And .Cells(rw1, 3).Value = "A" Then
            If MySel1 Is Nothing Then
                Set MySel1 = .Cells(rw1, 1).EntireRow
                Workbooks.Open Filename:="C:\CODE\Team Lists\11 Minor Novice A.xlsx"
            Else
                Set MySel1 = Union(MySel1, .Cells(rw1, 1).EntireRow)
            End If
        End If
    Next rw1
End With

With ThisWorkbook.Worksheets("M Novice A")
    lastrow1 = .Cells(.Rows.Count, 1).End(xlUp).Row
    If Not MySel1 Is Nothing Then
        MySel1.Copy Destination:=.Cells(lastrow1 + 1, 1)
        ' Uncomment the line below if you want to delete original rows after copying
        ' MySel1.Delete
    End If
End With

Dim Rng1 As Range
Set Rng1 = ThisWorkbook.Worksheets("M Novice A").Range("A1:AY300")
Rng1.Copy

Dim s111 As Workbook
Set s111 = Workbooks("11 Minor Novice A.xlsx")
Dim last1 As Long
Dim Rngnew1 As Range

With s111.Sheets("Sheet1")
    If Application.WorksheetFunction.CountA(.Cells) <> 0 Then
        last1 = .Range("A65000").End(xlUp).Offset(1, 0).Row
    Else
        last1 = 1
    End If
End With
' Fixed typo: replaced undefined "last" with "last1"
Set Rngnew1 = s111.Worksheets("Sheet1").Range("A" & last1)
Rngnew1.PasteSpecial

Key Changes Explained

  1. Exact Match for Column C:

    • Swapped .Cells(rw1, 3).Value Like "*A*" for .Cells(rw1, 3).Value = "A" to strictly target cells that are exactly "A"—no more accidental matches for AE, AA, or AAA.
    • If your data might have hidden spaces around the "A", use Trim(.Cells(rw1, 3).Value) = "A" to ignore leading/trailing whitespace.
  2. Typo Fix:

    • Corrected Range("A" & last) to Range("A" & last1) because last wasn't defined in your original code—this prevents a runtime error when pasting to the target workbook.

How It Works Now

The code will only select and move rows where:

  • Column B contains "Minor Novice" (still using partial match with Like "*Minor Novice*")
  • Column C is exactly equal to "A"

Then it copies those rows to your specified sheet and workbook as intended.

内容的提问来源于stack exchange,提问作者matt.auerbach

相关产品推荐
方舟 Agent Plan

超全模态模型 × Harness 升级,最新支持 Deepseek-V4.1-Flash、GLM-5.3 系列、Doubao-Seedream-5.0-pro、Kimi-K3 (部分), 限时 9.9 元起

最近更新时间:2026.05.14 06:47:55