我正在嘗試將原始代碼更改為一些新的代碼行
所以如果 c = 某些文本，如果高度在某個數字之間，則會分配一個值。但是當我運行新代碼時，VBA 給了我一個錯誤：未設定物件變數...幫助！
請參閱下面的原始代碼，它可以很好地作業原始代碼：
Sub TheMiddleMan()
Dim ws As Worksheet, lr As Long, c As Range, rng As Range, x As Long
Set ws = ActiveSheet
Set rng = ws.Range("L2", Cells(Rows.Count, "L").End(xlUp))
lr = ws.Cells(Rows.Count, 11).End(xlUp).Row
For Each c In ws.Range("K2:K" & lr)
If c = "C BOX (6""" & " WALL)" Or _
c = "C BASE (6""" & " WALL)" Or _
c = "C COLLAR (6""" & " WALL)" Or _
c = "D BOX (6""" & " WALL)" Or _
c = "SAN MH(5""" & " WALL)" Or _
c = "MH 72""" & " DIA(8""" & " WALL)" Then
c = c & " " & c.Offset(, 1)
End If
Next c
For Each c In rng
x = Val(c)
Select Case x
Case 12 To 19
c.Offset(, -8).Value = "F22122J"
Case 20 To 32
c.Offset(, -8).Value = "F22123J"
Case 33 To 42
c.Offset(, -8).Value = "F22124J"
End Select
Next
End Sub
以下是新代碼 新代碼：
Sub TheMiddleMan()
Dim ws As Worksheet, lr As Long, c As Range, rng As Range, x As Long, d As Range
Set ws = ActiveSheet
Set rng = ws.Range("L2", Cells(Rows.Count, "L").End(xlUp))
lr = ws.Cells(Rows.Count, 11).End(xlUp).Row
For Each d In ws.Range("K2:K" & lr)
If d = "C BOX (6""" & " WALL)" Or _
d = "C BASE (6""" & " WALL)" Or _
d = "C COLLAR (6""" & " WALL)" Or _
d = "D BOX (6""" & " WALL)" Or _
d = "SAN MH(5""" & " WALL)" Or _
d = "MH 72""" & " DIA(8""" & " WALL)" Then
d = d & " " & d.Offset(, 1)
End If
Next
For Each c In rng
For Each d In ws.Range("K2:K" & lr)
x = Val(c)
Select Case x
Case 12 To 19
If d = "C BOX (6""" & " WALL)" Then
c.Offset(, -8).Value = "F22122J"
End If
If d = "C Base (6""" & " WALL)" Then
c.Offset(, -8).Value = "F21123J"
End If
Case 20 To 32
If d = "C BOX (6""" & " WALL)" Then
c.Offset(, -8).Value = "F21122J"
End If
If d = "C Base (6""" & " WALL)" Then
c.Offset(, -8).Value = "F21123J"
End If
Case 33 To 42
If d = "C BOX (6""" & " WALL)" Then
d.Offset(, -8).Value = "F21122J"
End If
If d = "C Base (6""" & " WALL)" Then
d.Offset(, -8).Value = "F21123J"
End If
End Select
Next
Next
結束子
用于更新 D 列的代碼（這本身就可以正常作業）：
Sub ZackCase()
Dim ws As Worksheet, c As Range, rng As Range, x As Long
Set ws = ActiveSheet
Set rng = ws.Range("L2", Cells(Rows.Count, "L").End(xlUp))
For Each c In rng
x = Val(c)
Select Case x
Case 12 To 19
c.Offset(, -8).Value = "F22122J"
Case 20 To 32
c.Offset(, -8).Value = "F22123J"
Case 33 To 42
c.Offset(, -8).Value = "F22124J"
End Select
Next
結束子
uj5u.com熱心網友回復：
一種可能的答案...
試試這個：
Sub TheMiddleMan2()
Dim ws As Worksheet, lr As Long, c As Range, rng As Range, x As Long, d As Range
Set ws = ActiveSheet
Set rng = ws.Range("L2", Cells(Rows.Count, "L").End(xlUp))
lr = ws.Cells(Rows.Count, 11).End(xlUp).Row
For Each c In rng
For Each d In ws.Range("K2:K" & lr)
x = Val(c)
Select Case x
Case 12 To 19
If d = "C BOX (6""" & " WALL)" Then
c.Offset(, -8).Value = "F22122J"
End If
If d = "C BASE (6""" & " WALL)" Then
c.Offset(, -8).Value = "F21123J"
End If
Case 20 To 32
If d = "C BOX (6""" & " WALL)" Then
c.Offset(, -8).Value = "F21122J"
End If
If d = "C BASE (6""" & " WALL)" Then
c.Offset(, -8).Value = "F21123J"
End If
Case 33 To 42
If d = "C BOX (6""" & " WALL)" Then
c.Offset(, -8).Value = "F21122J"
End If
If d = "C BASE (6""" & " WALL)" Then
c.Offset(, -8).Value = "F21123J"
End If
End Select
Next
Next
For Each d In ws.Range("K2:K" & lr)
Debug.Print d
Debug.Print "C BOX (6""" & " WALL)"
If d = "C BOX (6""" & " WALL)" Or _
d = "C BASE (6""" & " WALL)" Or _
d = "C COLLAR (6""" & " WALL)" Or _
d = "D BOX (6""" & " WALL)" Or _
d = "SAN MH(5""" & " WALL)" Or _
d = "MH 72""" & " DIA(8""" & " WALL)" Then
d = d & " " & d.Offset(, 1)
End If
Next
End Sub
我所做的更改：
- 使用“BASE”與“Base”的字串存在不一致，并進行了更改。
- 我顛倒了兩個主要回圈的順序，因為如果您按原始順序執行它們，則在您可以在
Select Case陳述句中進行測驗之前更改列 K。 - 該行
d = d & " " & c.Offset(, 1)應該是d = d & " " & d.Offset(, 1)（您剛剛更新了這個嗎？我現在沒有看到它，但我發誓我得到這個是因為物件 var 未設定問題）。
無論如何，我理解您的要求，這似乎對我有用。
更新的答案
Sub TheMiddleMan2()
Dim ws As Worksheet, lr As Long, c As Range, rng As Range, x As Long, d As Range
Set ws = ActiveSheet
Set rng = ws.Range("L2", Cells(Rows.Count, "L").End(xlUp))
lr = ws.Cells(Rows.Count, 11).End(xlUp).Row
'-------------------------------------
' Removed the previous c loop
'-------------------------------------
For Each d In ws.Range("K2:K" & lr)
x = Val(d.Offset(0, 1).Value)
Set c = d.Offset(0, -7) ' For ease of use and updating, I set c to be the cell in Column D. I know, it's a bad naming convention.
Select Case x
Case 12 To 19
If d = "C BOX (6""" & " WALL)" Then
c.Value = "BOX 12 to 19" ' I set all the values to be explicit so I know where in the Case Statement the end result came from.
End If
If d = "C BASE (6""" & " WALL)" Then
c.Value = "BASE 12 to 19"
End If
Case 20 To 32
If d = "C BOX (6""" & " WALL)" Then
c.Value = "BOX 20 to 32"
End If
If d = "C BASE (6""" & " WALL)" Then
c.Value = "BASE 20 to 32"
End If
Case 33 To 42
If d = "C BOX (6""" & " WALL)" Then
c.Value = "BOX 33 to 42"
End If
If d = "C BASE (6""" & " WALL)" Then
c.Value = "BASE 33 to 42"
End If
End Select
Next
For Each d In ws.Range("K2:K" & lr)
Debug.Print d
Debug.Print "C BOX (6""" & " WALL)"
If d = "C BOX (6""" & " WALL)" Or _
d = "C BASE (6""" & " WALL)" Or _
d = "C COLLAR (6""" & " WALL)" Or _
d = "D BOX (6""" & " WALL)" Or _
d = "SAN MH(5""" & " WALL)" Or _
d = "MH 72""" & " DIA(8""" & " WALL)" Then
d = d & " " & d.Offset(, 1)
End If
Next
End Sub
這就是我的樣子：
uj5u.com熱心網友回復：
使用另一張表配置每個專案的代碼
并使用 Match 找到它們
Option Explicit
Sub TheMiddleMan()
Dim ws As Worksheet, wsConfig As Worksheet
Dim k As Range, ar, s As String, h As String
Dim x As Single, lr As Long, n As Long, i As Long
Dim r As Long, c As Long, bHasL As Boolean
Dim rngItems As Range, v As Variant
Set ws = Sheets(1)
Set wsConfig = Sheets(2)
With wsConfig
lr = .Cells(.Rows.Count, "A").End(xlUp).Row
Set rngItems = .Range("A1:A" & lr)
End With
'MsgBox lr - 1 & " items found"
With ws
lr = ws.Cells(Rows.Count, "K").End(xlUp).Row
For Each k In .Range("K2:K" & lr)
s = Trim(k.Value2)
h = k.Offset(, 1) ' col L height
x = Val(h) ' remove "
' has item got height, romove for match
If Right(s, Len(h) 1) = " " & h Then
s = Left(s, Len(s) - Len(h) - 1)
bHasL = True
Else
bHasL = False
End If
' match
v = Application.Match(s, rngItems, 0)
If Not IsError(v) Then
' select column according to quantity
Select Case Val(x)
Case 12 To 19: c = 2
Case 20 To 32: c = 3
Case 33 To 42: c = 4
Case Else: c = 0
End Select
If c > 0 Then
' get code from config
k.Offset(, -7) = wsConfig.Cells(v, c)
End If
' add col L if not already
If bHasL = False Then
k.Value2 = k.Value2 & " " & h
End If
n = n 1
End If
Next
End With
MsgBox n & " rows matched", vbInformation
End Sub
轉載請註明出處，本文鏈接：https://www.uj5u.com/gongcheng/405372.html
標籤：