用附加文本分割单元格值

Question

我在列A中有数百行数据，我想每隔10行添加文本以使用excel vba进行数据分区。

Example:
|Col-A |Col-B
|D00112|00053
|D00112|00261
|D00112|00548
|etc...|etcXX
|D00112|00XXX ---row 500th 

Output:
|Col-A   |Col-B
|D00112-A|00053
|D00112-A|00261
|D00112-A|00548
|etc..   |etcXX
|D00112-B|xxxxx ---row 11th 
|D00112-B|xxxxx
|etc..   |xxxxx
|D00112-C|xxxxx ---row 20th
|D00112-C|xxxxx
|etc     |xxxxx

我试过这样做:

Dim wrk As Workbook
Dim sht As Worksheet
Dim trg As Worksheet
Set wrk = ActiveWorkbook
Set sht = wrk.Worksheets(1)
For i = 2 To 10
If sht.Range("A" & i).Value > 0 Then
sht.Range("A" & i).Value = "D00112-A"
End If
Next i
For j = 11 To 20
If sht.Range("A" & j).Value > 0 Then
sht.Range("B" & j).Value = "D00112-B"
End If
Next j
for etc..
next etc

是否有可能的方法使这个循环代码看起来简单和更快?这段代码执行

需要很长时间

Answer 1

请尝试使用下一个代码。它应该非常快，处理数组，只在内存中工作，并立即删除处理结果。但是，正如我在上面的评论中所说，字母表最多只能显示260行。下一段代码使用从前一段递增的ASCII码返回的下一个字符:

Sub SplitColumn()
Dim sh As Worksheet, lastR As Long, arr
Dim i As Long, k As Long, initL As Long

Set sh = ActiveSheet  'use here the sheet you need
lastR = sh.Range("A" & sh.rows.count).End(xlUp).row 'the last row in A:A
arr = sh.Range("A2:A" & lastR).Value2 'place the range in an array for faster iteration

initL = Asc("A") 'extract ASCII code from letter A
For i = 1 To UBound(arr)
arr(i, 1) = arr(i, 1) & "-" & Chr(initL)
k = k + 1: If k = 10 Then k = 0: initL = initL + 1
Next i
'drop the array content back (at once):
sh.Range("A2").Resize(UBound(arr), 1).Value2 = arr
End Sub

如果您需要以不同的方式处理字母，请尝试定义要应用的算法…

:

请测试下一个版本。它在每个字母上添加数字(从0到9)，将范围增加100倍:

Sub SplitColumnComplex()
Dim sh As Worksheet, lastR As Long, arr
Dim i As Long, k As Long, j As Long, initL As Long

Set sh = ActiveSheet  'use here the sheet you need
lastR = sh.Range("A" & sh.rows.count).End(xlUp).row 'the last row in A:A
arr = sh.Range("A2:A" & lastR).Value2 'place the range in an array for faster iteration

initL = Asc("A") 'extract ASCII code from letter A
For i = 1 To UBound(arr)
arr(i, 1) = arr(i, 1) & "-" & Chr(initL) & j 'add the letter plus a digit (from 0 to 9)
k = k + 1
If k Mod 10 = 0 Then j = j + 1               'at each 10 rows change the number
If k = 100 Then initL = initL + 1: j = 0: k = 0 'at each 100 rows change letter and reinitialize all variables
Next i
'drop the array content back (at once):
sh.Range("A2").Resize(UBound(arr), 1).Value2 = arr
End Sub