vba宏操作文本列函数在excel和改变优先级的信息与相同的delimeter

bwitn5fc 于 2023-03-04 发布在其他

关注(0)|答案(3)|浏览(160)

我总体上是相当新的excel，所以任何帮助都非常感谢，关于我的问题。
我从一个供应商那里下载了数据，识别数据，（第一列），在同一列中有一个人的名字和他们的参与者编号，用逗号隔开。信息不是excel的通用格式，单元格是文本格式。我将在以后转换，但只是想我会提到它，以防它对创建一个合适的vba宏很重要。
问题是标识数据列中逗号的数量并不总是相同的。

有时一行只有参与者编号
有时一行包含姓、名、参与者编号
有时一行有名字、参与者编号。

参与者编号将始终位于识别列的最后，其前面只有可变数量的逗号，因为如果个人希望匿名，姓名可能不存在或仅部分存在。
我尝试做的是将其分开，以便参与者编号在单独的列中。姓可以与名放在一起，也可以在单独的列中。这两种方式都可以。姓名会更改，行数也会经常更改，但每次运行此宏时可能会更改大约1000行。
数据开始是这样的：

我在excel中使用record macro创建了这个宏。本质上我在标识列的右边添加了两列，然后使用文本到列的功能，用逗号分隔数据。因此标识数据被放入三列，然后我重命名了这三列。

Sub Add_and_rename_columns()

' Add_and_rename_columns Macro

'
    Columns("B:B").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Columns("A:A").Select
    Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
        :=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True
    Range("A3").Select
    ActiveCell.FormulaR1C1 = "Participant Last Name"
    Range("B3").Select
    ActiveCell.FormulaR1C1 = "Participant First Name"
    Range("C3").Select
    ActiveCell.FormulaR1C1 = "Participant Number"
    
End Sub

在宏之后，我得到了这个：

正如您所看到的，并非所有参与者的编号都在同一列中。感谢您给予的任何帮助。

excel

来源：https://stackoverflow.com/questions/75618921/vba-macro-manipulating-text-to-column-function-in-excel-and-change-priority-of-i

3条答案

按热度按时间

e5nqia271#

如果我没理解错的话...
运行潜艇前的数据如下：

下入接头后（预期结果）：

Sub test()
Dim rg As Range: Dim cell As Range
Dim cnt As Integer

With ActiveSheet
Set rg = .Range("A4", .Range("A" & Rows.Count).End(xlUp))
End With

rg(1, 2).Resize(1, 2).EntireColumn.Insert

For Each cell In rg
    cnt = Len(cell.Value) - Len(Replace(cell.Value, ",", ""))
    With cell.Resize(1, 3)
        If cnt = 0 Then .Value = Split(",," & cell.Value, ",")
        If cnt = 1 Then .Value = Split(Replace(cell.Value, ",", ",,"), ",")
        If cnt = 2 Then .Value = Split(cell.Value, ",")
    End With
Next

Range("A3").Value = "Participant Last Name"
Range("B3").Value = "Participant First Name"
Range("C3").Value = "Participant Number"

End Sub

rg变量是A列从第4行到最后一行的数据范围，然后插入两列，再循环到rg中的每个单元格。
在循环中，它填充每个循环单元格。调整大小（1，3），拆分单元值得到的数组用逗号分隔，先检查循环单元值中是否没有逗号，然后在循环单元值前加两个逗号，再拆分，如果循环单元值中有一个逗号，则用两个逗号替换一个逗号。然后拆分它。如果循环单元格值中有两个逗号，则它只拆分循环单元格值。

赞(0）回复(0）举报 2023-03-04

pgky5nke2#

从列表中插入两个空白列，编辑下面的列范围，然后尝试

Sub separate_values()
    Dim rng As Range
    Dim cell As Range
    Dim arr() As String
    Dim i As Long, lastRow As Long
    
    lastRow = Cells(Rows.Count, 1).End(xlUp).Row
    Set rng = Range("A1:A" & lastRow) ' Range of cells to check
    
    For Each cell In rng
    If cell.Value <> "" Then
        If InStr(1, cell.Value, ",") = 0 Then
            Cells(cell.Row, 3) = cell.Value
            Cells(cell.Row, 1) = ""
        Else
            arr = split(cell.Value, ",") ' Split cell value by comma and add to array
        
            For i = UBound(arr) To 0 Step -1
                 If UBound(arr) = 2 Then
                 Cells(cell.Row, i + 1) = arr(i)
                 Else
                 Cells(cell.Row, i + 2) = arr(i)
                 Cells(cell.Row, 1) = ""
                 End If
            Next i
           End If
           End If
    Next cell
End Sub

赞(0）回复(0）举报 2023-03-04

91zkwejq3#

非常感谢你们两个的帮助。卡玛的回答对我的需要稍微好一点，但两个回答都做了我需要做的。我感谢你们两个的回答。

赞(0）回复(0）举报 2023-03-04