vba - 附加到 VBA 中的单元格值

Question

我敢肯定这里有一个明显的答案，但我被困住了。这部分特别是抛出 424: Object Required。对我来说，真正奇怪的部分是它确实成功地将 0 附加到该列，但随后停止，并且不再继续。

If cellLen < 9 Then
        Set C.Value = 0 & C.Value
End If

为清楚起见，其余代码如下。如果不清楚，这是预期的代码流:

抓取命名字段

将这些列复制到新工作表

重命名它们并删除原始工作表

创建一些用于不同脚本的新工作表

搜索特定列中缺少的前导 0

将它们重新添加(这是中断的部分)

删除特定列的单元格值为 0 的行

将清理后的列拉出到新文件并保存

Sub Cleanup_Mapwise_Import()

Dim targetCols As Variant
Dim replColNames As Variant
Dim index As Integer
Dim found As Range
Dim counter As Integer
Dim headerIndex As Integer
Dim question As Integer
Dim rowCount As Variant
Dim colNum As Variant
Dim colLetter As Variant
Dim C As Range
Dim cellLen As Integer


' Add or remove fields to be copied here

targetCols = Array("gs_account_number", "gs_meter_number", "gs_amr_identification", _
                   "gs_amr_phase", "gs_city", "Name", "Phase", _
                   "gs_rate_schedule", "gs_service_address", _
                   "gs_service_map_location", "gs_service_number")

' Put the same fields from above in the desired order here, with the desired name

replColNames = Array("Acct #", "Meter #", "AMR ID", "AMR Phase", "City", _
                     "Name", "Phase", "Rate", "Address", "Srv Map Loc", "Srv Num")

counter = 1
ActiveSheet.Range("A1").Select

' This counts the number of columns in the source array and sets the index to that value
For index = LBound(targetCols) To UBound(targetCols)

    Set found = Rows("1:1").Find(targetCols(index), LookIn:=xlValues, LookAt:=xlWhole, _
                                 SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False)

' This is basically an insertion sort, and ends up with the columns in A:K

    If Not found Is Nothing Then
        If found.Column <> counter Then
            found.EntireColumn.Cut
            Columns(counter).Insert shift:=xlToRight
            Application.CutCopyMode = False
        End If
        counter = counter + 1
    End If

Next index

' There is a more dynamic way of doing this, using index
' As it is, replace A:K with the range of actual data
' PROTIP: targetCols is 1-indexed, and has 11 entries -->
' A:K encompasses that entire array -->
' Add/subtract 1 for each entry you add/remove

Range("A:K").Cut
Set TargetSheet = Sheets.Add(After:=Sheets(Sheets.Count))
TargetSheet.Name = "Contributors"
Range("A:K").Insert
question = MsgBox("Do you want to delete the original sheet?", vbYesNo + vbQuestion, "Delete Sheet")
If question = vbYes Then
    Sheets(1).Activate
    Sheets(1).Delete
Else
    End If
Sheets.Add.Name = "Data"
Sheets("Contributors").Move After:=Sheets("Data")
Sheets.Add.Name = "Graph"
Sheets("Graph").Move After:=Sheets("Contributors")
Sheets("Data").Activate
Range("A1").Value = "Date/Time"
Range("B1").Value = "kW"
Range("C1").Value = "Amps"

' Yes, counter is 0-indexed here, and 1-indexed previously
' headerIndex does an absolute count of 0 To # targetCols, whereas index is relative
' If you change these, there is a non-zero chance that the For will throw an error

counter = 0
Sheets("Contributors").Activate
ActiveSheet.Range("A1").Select
For headerIndex = 0 To (UBound(targetCols) - LBound(targetCols))

    ActiveCell.Value = replColNames(counter)
    ' If you don't use a Range, it fits columns based on headers, which isn't large enough
    ' A1:Z500 is a big enough sample to prevent that
    ActiveCell.Range("A1:Z500").Columns.AutoFit
    ActiveCell.Offset(0, 1).Select
    counter = counter + 1

Next headerIndex

' Find column number with meters numbers, then assign its corresponding letter value
colNum = Application.WorksheetFunction.Match("Meter #", Range("A1:ZZ1"), 0)
colLetter = (Split(Cells(, colNum).Address, "$")(1))
rowCount = Range(colLetter & Rows.Count).End(xlUp).Row

'Range(colLetter & "2:" & colLetter & rowCount).Select
'Selection.SpecialCells(xlCellTypeBlanks).Select
'Selection.Delete Shift:=xlUp

' Meter numbers are 9 digits, so if one is shorter, assume a trimmed leading 0 and append it
For Each C In Range(colLetter & "2:" & colLetter & rowCount).Cells
    ' If cell type isn't set to text, the 0s will be non-visible, which while not an issue for the CSV, is confusing
    ' Note that this does not persist, as CSVs have no way of saving Excel's formatting
    C.NumberFormat = "@"
    cellLen = Len(C.Value)
    If C.Value = "0" Or cellLen = 0 Then
        C.Delete shift:=xlUp
    End If
    If cellLen < 9 Then
        Set C.Value = 0 & C.Value
    End If
Next C

question = MsgBox("Do you want to create a CSV file with meter numbers for use with MDMS?", vbYesNo + vbQuestion, "MDMS File")
If question = vbYes Then
    ' Call CopyMeters for use with MDMS
    Sheets("Contributors").Activate
    CopyMeters
Else
    End If
End Sub



Sub CopyMeters()
Dim index As Integer
Dim fileSaveName As Variant
Dim rowCount As Variant
Dim colNum As Variant
Dim colLetter As Variant
Dim cellLen As Integer


colNum = Application.WorksheetFunction.Match("Meter #", Range("A1:ZZ1"), 0)
colLetter = (Split(Cells(, colNum).Address, "$")(1))
rowCount = Range(colLetter & Rows.Count).End(xlUp).Row

MsgBox ("Filename will automatically be appended with ""Meter List""")
fileSaveName = Split(ActiveWorkbook.Name, ".")
fileSaveName = fileSaveName(LBound(fileSaveName)) & " Meter List"

'For Each C In Range(colLetter & "2:" & colLetter & rowCount)
'    C.NumberFormat = "@"
'    cellLen = Len(C)
'    If C.Value = "0" Or cellLen = 0 Then
'        C.Delete shift:=xlUp
'    End If
'    If cellLen < 9 And cellLen <> 0 Then
'        C.Value = "0" & C.Value
'    End If
'Next C

Range(colLetter & "1:" & colLetter & rowCount).EntireColumn.Copy
Set newBook = Workbooks.Add
newBook.Worksheets("Sheet1").Range("A1").PasteSpecial (xlPasteAll)

Selection.Replace What:="0", Replacement:="", LookAt:=xlWhole, _
    SearchOrder:=xlByColumns, MatchCase:=False, SearchFormat:=False, _
    ReplaceFormat:=False

Selection.Columns.AutoFit
newBook.SaveAs Filename:=fileSaveName, FileFormat:=xlCSV, CreateBackup:=False

End Sub

Answer 1

错误消息告诉您 C 不是对象。因此，您不需要 Set 语句。将您的代码更改为:

If cellLen < 9 Then
   C.Value = 0 & C.Value
End If