Split cell values with additional text-CodePudding

I have hundreds of rows data in column A, and I want to split every 10 rows with adding text to make partition of data with 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

I have tried something like this:

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

is there possible way to make this looping code looks simple and faster? this code takes long time for executing

CodePudding user response：

Please, try using the next code. It should be very fast, processing an array, working only in memory and drop the processed result at once. But, as I said in my above comment, the alphabet can be used as you show only up to 260 rows. The next code uses the next characters returned from the incremented ASCII code of the previous one:

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

If you need to handle letters in a different way, try to define an algorithm to be applied...

Edited:

Please, test the next version. It adds numbers (from 0 to 9) at each letter, increasing the range 100 times:

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