提问人:user16201107 提问时间:11/16/2023 最后编辑:BigBenuser16201107 更新时间:11/16/2023 访问量:68
VBA 宏在我的 PC 中运行良好,但在使用工作笔记本电脑的 Excel 中出现溢出错误
VBA Macro runs fine in my PC but gives me overflow error in Excel with work laptop
问:
调试器上的溢出错误突出显示了以下行:
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
答: 暂无答案
上一个:返回所有错误
评论