excel - 如何仅将拆分单元格的最后一个值复制到新工作表中
问题描述
我正在尝试将一串值复制到新工作表上的单个列中。我的代码在活动单元格中只有一个值时有效,但一旦有多个值,就会复制单元格中的每个值。我希望它仅将最新添加到新工作表上的列中。输入是从允许多项选择的下拉菜单中进行的选择。然后我将这些选择拆分并偏移到一个新的单元格 9 列(我还有其他下拉列表,这就是为什么有这么多空间,但更大的循环应该能够处理其他下拉列表)。
If InStr(1, Oldvalue, Newvalue) = 0 Then
Target.Value = Oldvalue & "; " & Newvalue
Dim txt As String
Dim i As Integer
Dim FullName As Variant
txt = ActiveCell.Value
FullName = Split(txt, ";")
For i = 1 To UBound(FullName)
ActiveCell.Offset(i, 9).Value = FullName(i)
ActiveCell.Offset(i, 9).Copy
Worksheets("Links").Range("A3").End(xlUp).Offset(2, 0).Insert
Next i
我只包含了有问题的代码循环,以简化寻找解决方案的过程。
解决方案
我最好的猜测是,在检测到更改时,您想更新9 个单元格中的不同值列表吗?
现在,您已经在管理一个不同的列表。您需要做的就是清除第 9 列单元格中的值,然后打印下拉列表中的值。
Private Sub Worksheet_Change(ByVal Target As Range)
'Code by Sumit Bansal from https://trumpexcel.com
' To allow multiple selections in a Drop Down List in Excel (without repetition)
Dim Oldvalue As String
Dim Newvalue As String
Application.EnableEvents = True
On Error GoTo Exitsub
If Target.Address = "$A$1" Then
If Target.SpecialCells(xlCellTypeAllValidation) Is Nothing Then
GoTo Exitsub
Else:
If Target.Value = "" Then GoTo Exitsub Else
Application.EnableEvents = False
Newvalue = Target.Value
Application.Undo
Oldvalue = Target.Value
If Oldvalue = "" Then
Target.Value = Newvalue
Else
If InStr(1, Oldvalue, Newvalue) = 0 Then
Target.Value = Oldvalue & "; " & Newvalue
Else:
Target.Value = Oldvalue
End If
End If
Dim txt As String
Dim i As Integer
Dim FullName As Variant
txt = ActiveCell.Value
FullName = Split(txt, ";")
ActiveCell.Offset(, 9).EntireColumn.Clear
For i = 0 To UBound(FullName)
ActiveCell.Offset(i, 9) = Trim(FullName(i))
Next i
End If
End If
Application.EnableEvents = True
Exitsub:
Application.EnableEvents = True
End Sub
但是,如果我想从多个下拉列表中获得不同的列表,或者 ; 分隔数组?管理不同列表的最佳方式是 Collection 或 Dictionary 对象。
如果那是您要寻找的东西,我将使用一种使用这些对象的方法来更新此答案。
根据您的反馈,我已将代码更新到下面,以使用集合对象从多个下拉列表中管理您的不同列表。
Option Explicit
Private col As Collection
' ^ we are defining this to the module level. That means it will retain values
' and be able to be referenced from any other place in the project.
Private Sub Worksheet_Change(ByVal Target As Range)
'Code by Sumit Bansal from https://trumpexcel.com
' To allow multiple selections in a Drop Down List in Excel (without repetition)
Dim Oldvalue As String
Dim Newvalue As String
Application.EnableEvents = True
On Error GoTo Exitsub
If Not Intersect(Target, Range("$A$1:$B$1")) Is Nothing Then
' ^ this will make the area your looking more specific than just .row = 11
' you could also replace the address with a namedRange
If Target.SpecialCells(xlCellTypeAllValidation) Is Nothing Then
GoTo Exitsub
Else:
If Target.Value = "" Then
'' My guess is that here you would want to make a call to a function that
'' removes values from the function. You should be able to loop over the collection
'' to find the value to remove.
GoTo Exitsub
Else
Application.EnableEvents = False
Newvalue = Target.Value
Application.Undo
Oldvalue = Target.Value
If Oldvalue = "" Then
Target.Value = Newvalue
Else
If InStr(1, Oldvalue, Newvalue) = 0 Then
Target.Value = Oldvalue & "; " & Newvalue
Else:
Target.Value = Oldvalue
End If
End If
ManageList Newvalue
' ^ you already have the newest value. You just need a easy way to check if it
' is in the list. To do this I made a sub that receives text, and checks
' if it is in the publicly scoped collection.
End If
End If
End If
Application.EnableEvents = True
Exitsub:
Application.EnableEvents = True
End Sub
Private Sub ManageList(txt As String)
' This Sub will receive a text value and try to put it in a collection.
If col Is Nothing Then Set col = New Collection
On Error Resume Next
col.Add Item:=txt, Key:=txt
' ^ this method will throw an error if the Key is already in the collection.
' all we need to do then is watch for errors, and handle if we found a new one.
' I have found that collections and dictionary objects can handle .5M keys without any issues.
' using a dictionary, would allow you to test for a key without defining an error handler.
' with the trade off being that you have to add an additional reference to your project.
If Err.Number = 0 Then
' we had a new value
PrintList col
End If
End Sub
Private Sub PrintList(col As Collection)
Dim printTo As Range
Dim i As Long
Set printTo = Range("e1")
' ^ change e1 to a fully qualified address of where you
' want you list to be printed.
printTo.EntireColumn.Clear
On Error GoTo eos:
For i = 0 To col.Count - 1
printTo.Offset(i) = col(i + 1)
Next
eos:
End Sub
推荐阅读
- c# - 为什么当我尝试在 RecData() 方法中接收数据时,我的 udp 客户端没有抛出异常?
- docker - Docker 运行:无效的参考格式
- python - 读取文本文件并将其解析到结构 json 文件中 - 在 json 文件中返回不需要的键和 null/dict
- r - 在绘制“tmap”库期间在“R”中将标签放置在绘图区域之外(部分)
- powershell - 加载表格后,检查列表中的项目并倒计时
- infopath - 如何在 InfoPath 日期字段中限制日期值以允许从今天起 45 天的范围?
- java - 如何从java中的方法重定向到jsp?
- google-cloud-platform - 在 Google Cloud Platform Console 上启用 Google Ads API 的问题
- c# - 寻求诊断 SQL IndexOutOfRangeException 和 SQLException 的帮助
- php - 正确注释类方法返回值