VBA检查范围内单元格值的长度

我有填充主工作表A列（A7:A446）中单元格的代码。这些值列在不同的工作表（Sheet3）中，用户双击要在主工作表上填充活动单元格的代码。这些代码有相应的描述（E列，E7:E446），代码本身应该有21个字符长。目前，“说明”列（E列）有一个IF（ISNA（VLOOKUP…）公式，用于提取与表3中双击的帐户代码相关联的帐户说明。我想用VBA编写，这是一个检查a列中的代码是否有21个字符长的子程序。如果帐户代码长度不超过21个字符，我希望说明（仅说明）为“N/A”，以表明代码无效。此外，如果A列中的代码不等于第3页中列出的任何账户代码，我希望采取相同的行动，E列中的描述为“不适用，且仅为描述”

我知道我可能可以在“描述”列本身中使用公式或函数来实现这一点，但为了更好地熟悉VBA，我希望这样做。我曾尝试编写一个子函数来实现这一点，但它一直不起作用。我想我已经将一些变量设置为不正确的数据类型，但我不完全确定。有什么帮助吗/如有建议，将不胜感激

  Sub acctCodeVarification()

acctCode = Sheet2.Range("C7:C446").Value
acctDesc = Sheet2.Range("E7:E446").Text

For Each c In Range("C7:C446").Cells
    If Len(c) <> 21 Then
    c.acctDesc = "N/A"
    If c <> Sheet3.Range("A1:A20681").Value Then
    c.acctDesc = "N/A"

    End If
    End If
Next c

End Sub

Sub-acctdevalization（）
acctCode=Sheet2.范围（“C7:C446”）.值
acctDesc=Sheet2.范围（“E7:E446”）.文本
对于范围内的每个c（“C7:C446”）。单元格
如果Len（c）21，则
c、 acctDesc=“不适用”
如果c表3.范围（“A1:A20681”）.值，则
c、 acctDesc=“不适用”
如果结束
如果结束
下一个c
端接头

由于以下变量被声明为字符串，因此它们不需要“Set”语句。因此，不需要：

Set acctCode = Sheet2.Range("C7:C446").Value
Set acctDesc = Sheet2.Range("E7:E446").Text

这样做：

acctCode = Sheet2.Range("C7:C446").Value
acctDesc = Sheet2.Range("E7:E446").Text

---

由于以下变量声明为字符串，因此它们不需要“Set”语句。因此，不需要：

Set acctCode = Sheet2.Range("C7:C446").Value
Set acctDesc = Sheet2.Range("E7:E446").Text

这样做：

acctCode = Sheet2.Range("C7:C446").Value
acctDesc = Sheet2.Range("E7:E446").Text

---

您的描述和提供的代码不匹配，这引发了一些问题，但以下是我根据您提供的代码所做的假设：

• 您的“主要”工作表是Sheet2
• 您的“验证”表是第3页
• 正在验证的科目代码位于主表C列，从单元格C7开始
• 描述（根本没有检查或验证）在主表E列中，从单元格E7开始
• 要验证的实际账户代码列表位于验证表A列
• 如果要检查的科目代码不完全是21个字符，请将该单元格（主表中的C列）及其说明设置为“N/A”
• 如果帐户代码为21个字符，但在验证列表中找不到，则仅将说明设置为“N/A”

按照该逻辑，此代码应适用于您：

Sub tgr()

    Dim wb As Workbook
    Dim wsMain As Worksheet
    Dim wsVerify As Worksheet
    Dim rAcctCodes As Range
    Dim rAcctCell As Range

    Set wb = ActiveWorkbook
    Set wsMain = wb.Sheets("Sheet2")    'Change to actual name of worksheet
    Set wsVerify = wb.Sheets("Sheet3")  'Change to actual name of worksheet
    Set rAcctCodes = wsMain.Range("C7", wsMain.Cells(wsMain.Rows.Count, "C").End(xlUp))

    For Each rAcctCell In rAcctCodes.Cells
        If Len(rAcctCell.Value) <> 21 Then rAcctCell.Value = "N/A"
        If WorksheetFunction.CountIf(wsVerify.Columns("A"), rAcctCell.Value) = 0 Then wsMain.Cells(rAcctCell.Row, "E").Value = "N/A"
    Next rAcctCell

End Sub

Sub-tgr（）
将wb设置为工作簿
将wsMain设置为工作表
将wsVerify设置为工作表
将rAcctCodes变暗为范围
暗淡rAcctCell As范围
设置wb=ActiveWorkbook
将wsMain=wb.Sheets（“Sheet2”）更改为工作表的实际名称
将wsVerify=wb.Sheets（“Sheet3”）更改为工作表的实际名称
设置racctcode=wsMain.Range（“C7”，wsMain.Cells（wsMain.Rows.Count，“C”）.End（xlUp））
对于racctcode.Cells中的每个rAcctCell
如果Len（rAcctCell.Value）21，则rAcctCell.Value=“N/A”
如果工作表function.CountIf（wsVerify.Columns（“A”），rAcctCell.Value）=0，则wsMain.Cells（rAcctCell.Row，“E”）.Value=“N/A”
下一个rAcctCell
端接头

您的描述和提供的代码不匹配，这引发了一些问题，但以下是我根据您提供的代码所做的假设：

• 您的“主要”工作表是Sheet2
• 您的“验证”表是第3页
• 正在验证的科目代码位于主表C列，从单元格C7开始
• 描述（根本没有检查或验证）在主表E列中，从单元格E7开始
• 要验证的实际账户代码列表位于验证表A列
• 如果要检查的科目代码不完全是21个字符，请将该单元格（主表中的C列）及其说明设置为“N/A”
• 如果帐户代码为21个字符，但在验证列表中找不到，则仅将说明设置为“N/A”

按照该逻辑，此代码应适用于您：

Sub tgr()

    Dim wb As Workbook
    Dim wsMain As Worksheet
    Dim wsVerify As Worksheet
    Dim rAcctCodes As Range
    Dim rAcctCell As Range

    Set wb = ActiveWorkbook
    Set wsMain = wb.Sheets("Sheet2")    'Change to actual name of worksheet
    Set wsVerify = wb.Sheets("Sheet3")  'Change to actual name of worksheet
    Set rAcctCodes = wsMain.Range("C7", wsMain.Cells(wsMain.Rows.Count, "C").End(xlUp))

    For Each rAcctCell In rAcctCodes.Cells
        If Len(rAcctCell.Value) <> 21 Then rAcctCell.Value = "N/A"
        If WorksheetFunction.CountIf(wsVerify.Columns("A"), rAcctCell.Value) = 0 Then wsMain.Cells(rAcctCell.Row, "E").Value = "N/A"
    Next rAcctCell

End Sub

Sub-tgr（）
将wb设置为工作簿
将wsMain设置为工作表
将wsVerify设置为工作表
将rAcctCodes变暗为范围
暗淡rAcctCell As范围
设置wb=ActiveWorkbook
将wsMain=wb.Sheets（“Sheet2”）更改为工作表的实际名称
将wsVerify=wb.Sheets（“Sheet3”）更改为工作表的实际名称
设置racctcode=wsMain.Range（“C7”，wsMain.Cells（wsMain.Rows.Count，“C”）.End（xlUp））
对于racctcode.Cells中的每个rAcctCell
如果Len（rAcctCell.Value）21，则rAcctCell.Value=“N/A”
如果工作表function.CountIf（wsVerify.Columns（“A”），rAcctCell.Value）=0，则wsMain.Cells（rAcctCell.Row，“E”）.Value=“N/A”
下一个rAcctCell
端接头

试试这个：

Dim acctCode As Range
Set acctCode = Worksheets("Sheet2").Range("C7:C446")

For Each c In Range("C7:C446").Cells
If Len(c.Value) <> 21 Then
    Worksheets("Sheet2").Range("E" & c.Row) = "N/A"
Else
    If Worksheets("Sheet3").Range("A1:A20681").Find(c.Value,LookIn:=xlValues).Value Is Nothing Then
        Worksheets("Sheet2").Range("E" & c.Row) = "N/A"
    Else
        Worksheets("Sheet2").Range("E" & c.Row) = c.Value
    End If
End If
Next c

Dim acctCode As范围
设置acctCode=工作表（“Sheet2”）。范围（“C7:C446”）
对于范围内的每个c（“C7:C446”）。单元格
如果Len（c.值）21，则
工作表（“表2”）。范围（“E”和“c”行）=“不适用”
其他的
如果工作表（“Sheet3”）.Range（“A1:A20681”）.Find（c.Value，LookIn:=xlValues）。则值为零
工作表（“表2”）。范围（“E”和“c”行）=“不适用”
其他的
工作表（“表2”）。范围（“E”和c.Row）=c.值
如果结束
如果结束
下一个c

试试这个：

Dim acctCode As Range
Set acctCode = Worksheets("Sheet2").Range("C7:C446")

For Each c In Range("C7:C446").Cells
If Len(c.Value) <> 21 Then
    Worksheets("Sheet2").Range("E" & c.Row) = "N/A"
Else
    If Worksheets("Sheet3").Range("A1:A20681").Find(c.Value,LookIn:=xlValues).Value Is Nothing Then
        Worksheets("Sheet2").Range("E" & c.Row) = "N/A"
    Else
        Worksheets("Sheet2").Range("E" & c.Row) = c.Value
    End If
End If
Next c

Dim acctCode As范围
设置acctCode=工作表（“Sheet2”）。范围（“C7:C446”）
对于范围内的每个c（“C7:C446”）。单元格
如果Len（c.值）21，则
工作表（“表2”）。范围（“E”和“c”行）=“不适用”
其他的
如果工作表（“Sheet3”）.Range（“A1:A20681”）.Find（c.Value，LookIn:=xlValues）。则值为零
工作表（“表2”）。范围（“E”和“c”行）=“不适用”
埃尔