我在 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
有沒有辦法讓這個回圈代碼看起來簡單快捷?此代碼需要很長時間才能執行
uj5u.com熱心網友回復:
請嘗試使用下一個代碼。它應該非常快,處理一個陣列,只在記憶體中作業并立即洗掉處理后的結果。但是,正如我在上面的評論中所說,字母表可以用于您最多顯示 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
轉載請註明出處,本文鏈接:https://www.uj5u.com/ruanti/487662.html
