[英]Excel Macro - Comma Separated Cells to Rows
我在excel中有以下数据:
a, b, c
d
e
f, g
h
i
每行代表一行和一个单元格。
我想将其转换为:
a
b
c
d
e
f
g
h
i
我正在使用以下宏,但我不能让自动调整大小来执行插入,而不是覆盖单元格值。 任何帮助表示赞赏。
Sub SplitCells()
Dim i As Long
With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
For i = 1 To Selection.Rows.Count
Dim splitValues As Variant
splitValues = split(Selection.Rows(i).Value, ",")
Selection.Rows(i).Resize(UBound(splitValues) - LBound(splitValues) + 1).Value = Application.Transpose(splitValues)
Next i
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With
End Sub
这个宏将从A列获取数据并将其“提取”到B列。结果显示如下,随意畏缩我的图形演示技巧:-)
<- A -> <- B ->
1 a, b, c a
2 d b
3 e c
4 f, g d
5 h e
6 i f
7 g
8 h
9 i
我将其作为非破坏性的测试用途,因为创建新列相对容易,填充它并删除VBA中的旧列。 为读者练习......
这是宏:
Option Explicit
Sub Macro1()
Dim fromCol As String
Dim toCol As String
Dim fromRow As String
Dim toRow As String
Dim inVal As String
Dim outVal As String
Dim commaPos As Integer
' Copy from column A to column B.'
fromCol = "A"
toCol = "B"
fromRow = "1"
toRow = "1"
' Go until no more entries in column A.'
inVal = Range(fromCol + fromRow).Value
While inVal <> ""
' Go until all sub-entries used up.'
While inVal <> ""
Range(fromCol + fromRow).Select
' Extract each subentry.'
commaPos = InStr(1, inVal, ",")
While commaPos <> 0
' and write to output column.'
outVal = Left(inVal, commaPos - 1)
Range(toCol + toRow).Select
Range(toCol + toRow).Value = outVal
toRow = Mid(Str(Val(toRow) + 1), 2)
' Remove that sub-entry.'
inVal = Mid(inVal, commaPos + 1)
While Left(inVal, 1) = " "
inVal = Mid(inVal, 2)
Wend
commaPos = InStr(1, inVal, ",")
Wend
' Get last sub-entry (or full entry if no commas).'
Range(toCol + toRow).Select
Range(toCol + toRow).Value = inVal
toRow = Mid(Str(Val(toRow) + 1), 2)
inVal = ""
Wend
' Advance to next source row.'
fromRow = Mid(Str(Val(fromRow) + 1), 2)
Range(fromCol + fromRow).Select
inVal = Range(fromCol + fromRow).Value
Wend
End Sub
这是未经测试的,但它是我多次使用的算法模式。 虽然已经有一段时间了,所以不要完全信任语法。
sub SplitCells()
Dim c as Range ' iterator for cells in Selection
dim r as Range ' to hold the range which is the first cell in Selection
Dim r2 as Range ' variable range for single cell which is the target for inserting the result
Dim a() a Variant ' array of variants to hold each cell's value after it's split
Dim b() as Variant ' array of variants to hold the accumulation of values to spread into the destination
Dim v ar Variant ' variant to iterate through b for insertion
Dim i as Integer ' cumulative offset from top of destination range while inserting
For each c in Selection.Cells
a = Split(Replace(c.Text, ",", "")) ' will split on whitespace
for each v in a
b.Add v
next v
next c
' now you have a new array with the full set of values
' insert them a row at a time using Range.Offset
i = 0
Set r = Selection.Cells(0)
For Each v in b
Set r2 = r.Offset(1, 0)
r2.Value = v
i = i + 1
next v
End Sub
我不是很擅长Excel VBA,但这有用(不知何故!!)
Sub arrange()
' get the current range from the sheet
curr_range = ActiveSheet.Range("A1:A6")
' for each cell in that range ...
For Each Row In curr_range
' ...put the contents into an array
arr = Split(Row, ",")
' for each cell in that array ...
For Each cell In arr
' ...output it into a string
output_str = output_str & "," & cell
Next cell
Next Row
' remove spaces
output_str = Replace(output_str, " ", "")
' remove left ,
output_str = Right(output_str, Len(output_str) - 1)
' make it into an array
output_arr = Split(output_str, ",")
' populate the sheet back
ActiveSheet.Range("A:A").Value = Application.WorksheetFunction.Transpose(output_arr)
End Sub
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.