VBA打开将继续运行程序的新工作簿

Question

I have a massive amount of data, that i spooled from a really old system. Each record for the client does not appear in columns, but a mix of rows and columns. The only way I could split the data was by using the empty row to separate each record to new worksheet (in same workbook) then I will manipulate the data that way. My vba is working for this, but I have too many records and the worksheet capacity in the workbook reaches its limit (approx 1400, saved as sheet1, sheet2..) . Is there anyway I can incorporate into my vba to save the current workbook as perhaps record1, open a new workbook maybe entitled record2 and when this workbook is also full save, and continue process until all of the data is separated accordingly.

Here is my vba

        Private Sub excelsplit()
Dim wbk As Workbook
Dim l_str, l_end, l_row As Long

Set wbk = ThisWorkbook


Application.DisplayAlerts = False
Do Until wbk.Sheets.Count = 1
wbk.Sheets(wbk.Sheets.Count).Delete
Loop
Application.DisplayAlerts = True


l_str = 2
l_row = 2
Do While l_row <= wbk.Sheets(1).Range("A1000000").End(xlUp).Row + 1
If wbk.Sheets(1).Range("A" & l_row).Value = "" And _
wbk.Sheets(1).Range("B" & l_row).Value = "" And _
wbk.Sheets(1).Range("c" & l_row).Value = "" And _
wbk.Sheets(1).Range("d" & l_row).Value = "" And _
wbk.Sheets(1).Range("e" & l_row).Value = "" And _
wbk.Sheets(1).Range("f" & l_row).Value = "" And _
wbk.Sheets(1).Range("g" & l_row).Value = "" And _
wbk.Sheets(1).Range("h" & l_row).Value = "" And _
wbk.Sheets(1).Range("i" & l_row).Value = "" And _
wbk.Sheets(1).Range("j" & l_row).Value = "" And _
wbk.Sheets(1).Range("k" & l_row).Value = "" And _
wbk.Sheets(1).Range("l" & l_row).Value = "" Then
wbk.Sheets.Add after:=wbk.Sheets(wbk.Sheets.Count)
wbk.Sheets(wbk.Sheets.Count).Range("A2:l" & l_row - l_str + 1).Value = wbk.Sheets(1).Range("A" & l_str & ":l" & l_row).Value
l_str = l_row + 1
End If
l_row = l_row + 1
Loop

End Sub

I have 52000 rows of data, so would have to perform an open and shut scenario about 35 times. Any help would be much appreciated.

Attached is a screen shot of my data....the problem is the varying rows, and some cells have relevant enter image description here data but some don't. (I think to parse it)

this is my end result enter image description here

Answer 1

Please ignore this answer if you know that your data in Sheet1 has not a consistent pattern.

The code below is based by the look of the data in the first image (Sheet1).

Sub test()
Dim rg As Range: Dim cell As Range
Dim oFill As Range: Dim cnt As Long
Dim regID
Dim mil
Dim custBname
Dim custPHnum
Dim ref
Dim dt
Dim vat
Dim tot
Dim amt

With Sheets("Sheet1")
Set rg = .Range("i2", .Range("i" & Rows.Count).End(xlUp))
End With

Set oFill = Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)

cnt = 0

For Each cell In rg.SpecialCells(xlConstants)

    If IsNumeric(cell.Value) Then

        If cell.Offset(-1, -2).Value <> "" Then
            cnt = cnt + 1
            regID = "id-" & Format(cnt, "000")
            mil = cell.Offset(-2, -1).Value 'value for mileage
            custBname = cell.Offset(-2, 1).Value 'value for customer business name
            custPHnum = cell.Offset(-2, 2).Value 'value for customer phone number
        End If
    
        ref = cell.Value 'value for column Ref
        dt = cell.Offset(0, -1).Value 'value for column Date
        vat = Split(cell.Offset(0, 2).Value, " ")(0) 'value for VAT
        tot = Split(cell.Offset(0, 2).Value, " ")(Application.CountA(Split(cell.Offset(0, 2).Value, " ")) - 1) 'value for total
        amt = tot - vat 'value for amount
    
        oFill.Value = regID
        oFill.Offset(0, 1).Value = mil
        oFill.Offset(0, 2).Value = custBname
        oFill.Offset(0, 3).Value = custPHnum
        oFill.Offset(0, 4).Value = ref
        oFill.Offset(0, 5).Value = dt
        oFill.Offset(0, 6).Value = vat
        oFill.Offset(0, 7).Value = tot
        oFill.Offset(0, 8).Value = amt
    
        Set oFill = oFill.Offset(1, 0)
    
    End If
    
Next

End Sub

The sub assumed that in Sheet1 column i, if the row contains a number then the value of this row (for sure) is the ref number. For example based on your Sheet1 image, cell i16, i17, i22, i27, and so on.

The sub also assumed that there is always a value in column G where the row is just right above the row which contains the ref number. Sorry it's difficult for me to explain it in English. Anyway, for example :
cell i16.offset(-1,-2) ---> is cell G15 ---> so cell G15 must have a value (from your image, the value is 710).
cell i22.offset(-1,-2) ---> is cell G21 ---> so cell G21 must have a value(from your image, the value is avav).
And so on.

The process:
It make a range with data from column i Sheet1 into variable rg
It make a range to fill in Sheet2 into variable oFill
Make the cnt variable value as zero

Then it loop to each cell (which has value) in rg.
On each loop of the cell, it check if the cell value is a number.
if the cell value is a number, then it check if this cell.offset(-1,-2) has a value
if it has a value, then it means this looped cell has a new regID,
then it make a variable which contains the information needed coming from NOT the row of the looped cell. So the code make a regID, mil, custBname and custPHnum where the row with the value of them is two rows above the looped cell row.

Then it make another variable (ref, dt, vat, tot, amt) where the row with the value of them is the same with the looped cell row.

To get the vat and tot variable, it split the looped cell.offset(0,2) with " " into an array, where the vat value is the first item in the array, and the tot value is the last item in the array.
Then it subtract the tot with vat to get the value for amt variable.

Finally it fill the last empty row in column A of Sheet2 with all those needed information.

Based on the sample image data, the second looped cell with a number value is 4552 (cell i17). Since it won't find a value on cell i17.offset(-1,-2) ---> cell G16, then when it fill the last empty row in column A of Sheet2, the same information of regID, mil, custBname and custPHnum --- coming from the previous loop where it find a value in cell.offset(-1,-2) --- will be used.

The data "pattern" in Sheet1 must be consistent to get all those variables have a correct value.

I'm sorry as I can't test the sub as it's quite difficult for me to make the same data pattern as it looks in your Sheet1 image. So the sub above is not tested , but maybe can give you an idea to start.

The code above is tested with this kind of data pattern:

After run the sub, the result is like this :