1

阶段1

我正在尝试搜索具有字符串值（公式、文本、数字等）的范围内每一行的第一列。该字符串是通过从下拉列表中选择生成的。选择的格式类似于“Desktop，Dell，790 - 4GB”，我只关心第一个逗号之前的文本字符串（在本例中也称为“Desktop”。）我正在使用 Split() 方法来获取第一个逗号之前的单词，然后尝试使用 Case 语句将字符串插入同一行的另一个单元格。

阶段2

我正在使用在第一个下拉列表中选择的内容来填充具有预定值的第二个下拉列表。

问题

程序抛出运行时错误“1004”：Application_defined 或 object-defined 错误。我不知道从哪里开始。

原始代码

Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Whoops
Application.EnableEvents = False
Call splitter
If Not Intersect(Target, Range("B:B")) Is Nothing Then
If Not Target.HasFormula Then Target.Value = UCase(Target.Value)
End If
Whoops:
Application.EnableEvents = True
End Sub

Sub splitter()
   Dim line() As String
   Dim rng, row As Range
   Dim lRow, lCol As Long
   lRow = Cells.Find("*", Range("A1"), xlFormulas, , xlByRows, xlPrevious).row
   lCol = Cells.Find("*", Range("A1"), xlFormulas, , xlByColumns, xlPrevious).Column
   Set rng = Cells(lRow, lCol)

   For Each row In rng.Rows
    If row.Value <> "" Then
        line = Split(Range(row, 1), ",")
        Select Case line(0)
           Case "Desktop"
               Range(row, 8).Value = "Desktop"
           Case "Laptop"
               Range(row, 8).Value = "Laptop"
           Case "Server"
               Range(row, 8).Value = "Server"
           Case Else
               Range(row, 8).Value = "N/A"
        End Select
    End If
   Next
End Sub

修订代码

Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Whoops
Application.EnableEvents = False
Call splitter
If Not Intersect(Target, Range("B:B")) Is Nothing Then
If Not Target.HasFormula Then Target.Value = UCase(Target.Value)
End If
Whoops:
Application.EnableEvents = True
End Sub

Sub splitter()
   Dim line() As String
   Dim rng As Range, row As Range
   Dim lRow As Long
   lRow = Cells.Find("*", Range("A1"), xlFormulas, , xlByRows, xlPrevious).row
   Set rng = Cells("A1:N" & lRow)

   For Each row In rng.Rows
    If row.Value <> "" Then
        line = Split(Cells(row, 1), ",")
        Select Case line(0)
           Case "Desktop"
               Cells(row, 8).Value = "Desktop"
           Case "Laptop"
               Cells(row, 8).Value = "Laptop"
           Case "Server"
               Cells(row, 8).Value = "Server"
           Case Else
               Cells(row, 8).Value = "N/A"
        End Select
    End If
   Next
End Sub
4

1 回答 1

2

我已将您的两个代码合并为 1。

阶段1

这是你正在尝试的吗？

Private Sub Worksheet_Change(ByVal Target As Range)        
    On Error GoTo Whoa

    Application.EnableEvents = False

    If Not Intersect(Target, Columns(1)) Is Nothing Then
        If Target.Cells.Count > 1 Then GoTo LetsContinue

        If Target.Value <> "" And InStr(1, Target.Value, ",") Then
            Select Case Split(Target.Value, ",")(0)
               Case "Desktop": Range("H" & Target.row).Value = "Desktop"
               Case "Laptop":  Range("H" & Target.row).Value = "Laptop"
               Case "Server":  Range("H" & Target.row).Value = "Server"
               Case Else:      Range("H" & Target.row).Value = "N/A"
            End Select
        End If
    ElseIf Not Intersect(Target, Columns(2)) Is Nothing Then
        If Target.Cells.Count > 1 Then GoTo LetsContinue
        If Not Target.HasFormula Then Target.Value = UCase(Target.Value)
    End If

LetsContinue:
    Application.EnableEvents = True
    Exit Sub
Whoa:
    MsgBox Err.Description
    Resume LetsContinue
End Sub
于 2012-07-12T22:16:34.687 回答