英文:
Excel Text Split with one condition using VBA
问题
我已经能够在VBA中拆分文本,将一个单元格中的一系列数字分成4个不同的单元格。我一直在使用的方法可以实现这个目标,但我找不到一种方法来设置条件,以忽略拆分源单元格不符合特定格式的情况。
当一系列数字以句点分隔时,拆分文本。这已经可以正常工作。然而,当只有一个数字而没有句点时,我希望它能够忽略拆分。
例如,
5.10.4.3456 在C2中拆分为从C14开始的4个不同单元格:C14=5,C15=10,C16=4,C17=3456,这已经可以正常工作。然而,当数字没有句点分隔时(附件中突出显示的文本),是否有一种方法可以忽略该列中剩余单元格的拆分?数据集将在每次导出新集合时继续增长,因此范围将每周增加。
我使用Range选择整列,然后拆分它,但还有更多的随机单个数字应该被忽略(附件中突出显示)。
英文:
I've been able to split text in VBA to separate a series of numbers from one cell into 4 different cells. What I've been using works but I can't find a way to set a condition to ignore splitting it if the source cell isn't in a certain format.
When it's a series of numbers separated by a period, split the text. This already works. However, when it's just a number with no periods, I want it to ignore splitting it.
So for example,
5.10.4.3456 in C2 get split into 4 different cells starting on C14 = 5, C15=10, C16=4, C17=3456 and this works with no issue. However, when the number doens't have periods separating it (highlighted text in attachment), is there a way to ignore the split of the remaining cells in that column? The dataset will continue to grow every time we export a new set so the range will grow weekly.
I select an entire column using Range and then split it but there are more random single numbers that should be ignored (highlighted in attachment).
Range("C2:C12085").Select
Dim rng As Range
Set rng = Selection
rng.TextToColumns _
Destination:=rng(1, 1).Offset(, 14), _
TextQualifier:=xlTextQualifierDoubleQuote, _
DataType:=xlDelimited, _
SemiColon:=False, _
Comma:=False, _
Other:=True, _
Space:=False, _
OtherChar:="."
答案1
得分: 2
以下是翻译好的部分:
文本到列拆分功能要求单元格范围连续,没有间隙。但是您可以在拆分后从目标范围中删除不需要的单元格。
Dim rng As Range, lastRow As Long
lastRow = Cells(Rows.Count, "C").End(xlUp).Row
Set rng = Range("C2:C" & lastRow)
rng.TextToColumns _
Destination:=rng(1, 1).Offset(, 14), _
TextQualifier:=xlTextQualifierDoubleQuote, _
DataType:=xlDelimited, _
SemiColon:=False, _
Comma:=False, _
Other:=True, _
Space:=False, _
OtherChar:="."
Dim arrs, arrd, i
Dim rngD As Range
arrs = rng.Value
' 假设文本到列的结果在 Q 到 T 列
lastRow = Cells(Rows.Count, "Q").End(xlUp).Row
Set rngD = Cells(2, "Q").Resize(lastRow - 1, 4)
arrd = rngD.Value
For i = 1 To UBound(arrs)
If arrs(i, 1) = arrd(i, 1) Then arrd(i, 1) = ""
Next
rngD.Value = arrd
End Sub
我已经使用您的示例数据测试了该代码。在下一列中没有额外的数字。
英文:
The text-to-columns split function requires a contiguous range of cells without gaps. But you can remove the unwanted cells from the destination range after splitting.
Dim rng As Range, lastRow As Long
lastRow = Cells(Rows.Count, "C").End(xlUp).Row
Set rng = Range("C2:C" & lastRow)
rng.TextToColumns _
Destination:=rng(1, 1).Offset(, 14), _
TextQualifier:=xlTextQualifierDoubleQuote, _
DataType:=xlDelimited, _
SemiColon:=False, _
Comma:=False, _
Other:=True, _
Space:=False, _
OtherChar:="."
Dim arrs, arrd, i
Dim rngD As Range
arrs = rng.Value
' assuming text-to-column result in Q to T
lastRow = Cells(Rows.Count, "Q").End(xlUp).Row
Set rngD = Cells(2, "Q").Resize(lastRow - 1, 4)
arrd = rngD.Value
For i = 1 To UBound(arrs)
If arrs(i, 1) = arrd(i, 1) Then arrd(i, 1) = ""
Next
rngD.Value = arrd
End Sub
I have tested the code with your sample data. There isn't any extra number in the next column.
Screenshot from OP user. Column P may contain data. The issue is fixed in the updated code.
答案2
得分: 0
TextToColumns方法需要一个范围作为目标,而Offset方法不返回范围。
尝试这样做:
子过程 SplitTextToColumns()
Dim rng As Range
Set rng = Range("C2:C12085")
rng.TextToColumns _
Destination:=rng.Cells(1, 1).Offset(0, 14), _
TextQualifier:=xlTextQualifierDoubleQuote, _
DataType:=xlDelimited, _
SemiColon:=False, _
Comma:=False, _
Other:=True, _
OtherChar:="."
End Sub
英文:
TextToColumns method needs a Range as the destination, and the Offset method doesn't return a Range.
Try this :
Sub SplitTextToColumns()
Dim rng As Range
Set rng = Range("C2:C12085")
rng.TextToColumns _
Destination:=rng.Cells(1, 1).Offset(0, 14), _
TextQualifier:=xlTextQualifierDoubleQuote, _
DataType:=xlDelimited, _
SemiColon:=False, _
Comma:=False, _
Other:=True, _
OtherChar:="."
End Sub
通过集体智慧和协作来改善编程学习和解决问题的方式。致力于成为全球开发者共同参与的知识库,让每个人都能够通过互相帮助和分享经验来进步。
评论