VBA 宏在我的 PC 中运行良好,但在使用工作笔记本电脑的 Excel 中出现溢出错误

VBA Macro runs fine in my PC but gives me overflow error in Excel with work laptop

提问人:user16201107 提问时间:11/16/2023 最后编辑:BigBenuser16201107 更新时间:11/16/2023 访问量:68

问:

调试器上的溢出错误突出显示了以下行:

concatenatedValue = IIf(isDateColumn, Format(currentData, "mm/dd/yyyy"), currentData)

法典:


Option Explicit

Sub ConcatenateRowsByUniqueID()
    Dim uniqueIDColumn As Range
    Dim dataColumn As Range
    Dim isDateColumn As Boolean
    Dim resultColumn As Range
    Dim uniqueIDDict As Object
    Dim ws As Worksheet
    Dim i As Long
    
    ' Prompt for user input
    On Error Resume Next
    Set uniqueIDColumn = Application.InputBox("Select the column with unique IDs", Type:=8)
    On Error GoTo 0
    
    On Error Resume Next
    Set dataColumn = Application.InputBox("Select the column with data to concatenate", Type:=8)
    On Error GoTo 0
    
    If uniqueIDColumn Is Nothing Or dataColumn Is Nothing Then
        MsgBox "Invalid selection. Please try again.", vbExclamation
        Exit Sub
    End If
    
    isDateColumn = MsgBox("Is the selected data column a date?", vbYesNo + vbQuestion) = vbYes
    
    ' Set the result column
    Set ws = ActiveSheet
    Set resultColumn = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Offset(, 1)
    
    ' Initialize a dictionary to store unique IDs and their concatenated results
    Set uniqueIDDict = CreateObject("Scripting.Dictionary")
    
    ' Loop through the data and concatenate values
    For i = 1 To uniqueIDColumn.Rows.Count
        Dim currentID As Variant
        Dim currentData As Variant
        Dim concatenatedValue As String
        
        currentID = uniqueIDColumn.Cells(i, 1).Value
        currentData = dataColumn.Cells(i, 1).Value
        
        If Not IsEmpty(currentID) Then
            ' Check if the ID is already in the dictionary
            If uniqueIDDict.Exists(currentID) Then
                ' Concatenate the data to the existing value
                concatenatedValue = uniqueIDDict(currentID) & "," & IIf(isDateColumn, Format(currentData, "mm/dd/yyyy"), currentData)
            Else
                ' Add the ID to the dictionary
                concatenatedValue = IIf(isDateColumn, Format(currentData, "mm/dd/yyyy"), currentData)
            End If
            
            ' Store the concatenated result in the dictionary
            uniqueIDDict(currentID) = concatenatedValue
        End If
    Next i
    
    ' Output the results to the worksheet
    For i = 1 To uniqueIDColumn.Rows.Count
        Dim outputID As Variant
        outputID = uniqueIDColumn.Cells(i, 1).Value
        
        If Not IsEmpty(outputID) Then
            ' Retrieve the concatenated result from the dictionary and output to the result column
            ws.Cells(i, resultColumn.Column).Value = uniqueIDDict(outputID)
        End If
    Next i
End Sub

结果应该使用来自另一列的唯一 ID 将同一列但不同行的单元格合并到一个单元格中。结果必须在唯一 ID 行所在的位置重复。例如:

Unique ID| Data   | Result
098765   | AB.123 | AB.123 
654312   | CD.345 | CD.345,GH.098
654312   | GH.098 | CD.345,GH.098
340076   | EF.678 | EF.678
Excel VBA 错误处理 串联

评论


答: 暂无答案